annotate lisp/subr.el @ 18380:d515bf202434

(Fdelete_frame): Clear echo_area_glyphs if it was in this frame.
author Richard M. Stallman <rms@gnu.org>
date Sun, 22 Jun 1997 17:58:03 +0000
parents 3e4924d01221
children 83425393d550
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
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13936
diff changeset
3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995 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
14169
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13936
diff changeset
18 ;; along with GNU Emacs; see the file COPYING. If not, write to the
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13936
diff changeset
19 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13936
diff changeset
20 ;; Boston, MA 02111-1307, USA.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
21
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
22 ;;; Code:
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
23
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
24
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
25 ;;;; Lisp language features.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
26
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
27 (defmacro lambda (&rest cdr)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
28 "Return a lambda expression.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
29 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
30 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
31 expression itself. The lambda expression may then be treated as a
10178
be0081d9ba76 (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10025
diff changeset
32 function, i.e., stored as the function value of a symbol, passed to
be0081d9ba76 (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10025
diff changeset
33 funcall or mapcar, etc.
be0081d9ba76 (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10025
diff changeset
34
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
35 ARGS should take the same form as an argument list for a `defun'.
12395
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
36 DOCSTRING is an optional documentation string.
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
37 If present, it should describe how to call the function.
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
38 But documentation strings are usually not useful in nameless functions.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
39 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
40 It may also be omitted.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
41 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
42 ;; 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
43 ;; depend on backquote.el.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
44 (list 'function (cons 'lambda cdr)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
45
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
46 (defmacro when (cond &rest body)
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
47 "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
48 (list 'if cond (cons 'progn body)))
17158
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
49 (put 'when 'lisp-indent-function 1)
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
50 (put 'when 'edebug-form-spec '(&rest form))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
51
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
52 (defmacro unless (cond &rest body)
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
53 "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
54 (cons 'if (cons cond (cons nil body))))
17158
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
55 (put 'unless 'lisp-indent-function 1)
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
56 (put 'unless 'edebug-form-spec '(&rest form))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
57
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
58 ;;;; Keymap support.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
59
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
60 (defun undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
61 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
62 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
63
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
64 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
65 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
66 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
67
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
68 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
69 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
70 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
71 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
72 (substitute-key-definition 'self-insert-command 'undefined map global-map)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
73 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
74 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
75 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
76 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
77 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
78 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
79 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
80 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
81
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
82 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
83 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
84 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
85 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
86 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
87 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
88 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
89 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
90
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
91 (defvar key-substitution-in-progress nil
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
92 "Used internally by substitute-key-definition.")
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
93
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
94 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
95 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
96 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
97 If optional fourth argument OLDMAP is specified, we redefine
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
98 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
99 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
100 (let* ((scan (or oldmap keymap))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
101 (vec1 (vector nil))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
102 (prefix1 (vconcat prefix vec1))
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
103 (key-substitution-in-progress
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
104 (cons scan key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
105 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
106 ;; has any definition, and act on it with hack-key.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
107 (while (consp scan)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
108 (if (consp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
109 (let ((char (car (car scan)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
110 (defn (cdr (car scan))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
111 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
112 ;; the inside of the following let that handles array elements.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
113 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
114 (aset prefix1 (length prefix) char)
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
115 (let (inner-def skipped)
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
116 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
117 (while (stringp (car-safe defn))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
118 (setq skipped (cons (car defn) skipped))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
119 (setq defn (cdr defn)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
120 ;; Skip past cached key-equivalence data for menu items.
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
121 (and (consp defn) (consp (car defn))
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
122 (setq defn (cdr defn)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
123 (setq inner-def defn)
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
124 ;; Look past a symbol that names a keymap.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
125 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
126 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
127 (setq inner-def (symbol-function inner-def)))
17215
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
128 (if (or (eq defn olddef)
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
129 ;; Compare with equal if definition is a key sequence.
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
130 ;; That is useful for operating on function-key-map.
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
131 (and (or (stringp defn) (vectorp defn))
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
132 (equal defn olddef)))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
133 (define-key keymap prefix1 (nconc (nreverse skipped) newdef))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
134 (if (and (keymapp defn)
9986
df605fcd1e75 (substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 9822
diff changeset
135 ;; Avoid recursively scanning
df605fcd1e75 (substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 9822
diff changeset
136 ;; where KEYMAP does not have a submap.
13039
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
137 (let ((elt (lookup-key keymap prefix1)))
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
138 (or (null elt)
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
139 (keymapp elt)))
9986
df605fcd1e75 (substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 9822
diff changeset
140 ;; Avoid recursively rescanning keymap being scanned.
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
141 (not (memq inner-def
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
142 key-substitution-in-progress)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
143 ;; If this one isn't being scanned already,
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
144 ;; scan it now.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
145 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
146 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
147 prefix1)))))
18044
3e4924d01221 (substitute-key-definition): Check vectorp, not arrayp.
Richard M. Stallman <rms@gnu.org>
parents: 17943
diff changeset
148 (if (vectorp (car scan))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
149 (let* ((array (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
150 (len (length array))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
151 (i 0))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
152 (while (< i len)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
153 (let ((char i) (defn (aref array i)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
154 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
155 ;; the inside of the previous let.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
156 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
157 (aset prefix1 (length prefix) char)
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
158 (let (inner-def skipped)
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
159 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
160 (while (stringp (car-safe defn))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
161 (setq skipped (cons (car defn) skipped))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
162 (setq defn (cdr defn)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
163 (and (consp defn) (consp (car defn))
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
164 (setq defn (cdr defn)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
165 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
166 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
167 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
168 (setq inner-def (symbol-function inner-def)))
17215
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
169 (if (or (eq defn olddef)
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
170 (and (or (stringp defn) (vectorp defn))
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
171 (equal defn olddef)))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
172 (define-key keymap prefix1
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
173 (nconc (nreverse skipped) newdef))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
174 (if (and (keymapp defn)
13039
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
175 (let ((elt (lookup-key keymap prefix1)))
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
176 (or (null elt)
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
177 (keymapp elt)))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
178 (not (memq inner-def
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
179 key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
180 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
181 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
182 prefix1)))))
17922
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
183 (setq i (1+ i))))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
184 (if (char-table-p (car scan))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
185 (map-char-table
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
186 (function (lambda (char defn)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
187 (let ()
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
188 ;; The inside of this let duplicates exactly
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
189 ;; the inside of the previous let,
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
190 ;; except that it uses set-char-table-range
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
191 ;; instead of define-key.
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
192 (aset vec1 0 char)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
193 (aset prefix1 (length prefix) char)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
194 (let (inner-def skipped)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
195 ;; Skip past menu-prompt.
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
196 (while (stringp (car-safe defn))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
197 (setq skipped (cons (car defn) skipped))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
198 (setq defn (cdr defn)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
199 (and (consp defn) (consp (car defn))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
200 (setq defn (cdr defn)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
201 (setq inner-def defn)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
202 (while (and (symbolp inner-def)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
203 (fboundp inner-def))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
204 (setq inner-def (symbol-function inner-def)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
205 (if (or (eq defn olddef)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
206 (and (or (stringp defn) (vectorp defn))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
207 (equal defn olddef)))
17943
15dc805eadee (substitute-key-definition): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17922
diff changeset
208 (define-key keymap prefix1
15dc805eadee (substitute-key-definition): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17922
diff changeset
209 (nconc (nreverse skipped) newdef))
17922
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
210 (if (and (keymapp defn)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
211 (let ((elt (lookup-key keymap prefix1)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
212 (or (null elt)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
213 (keymapp elt)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
214 (not (memq inner-def
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
215 key-substitution-in-progress)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
216 (substitute-key-definition olddef newdef keymap
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
217 inner-def
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
218 prefix1)))))))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
219 (car scan)))))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
220 (setq scan (cdr scan)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
221
3902
717f2e24975e (define-key-after): Renamed from define-key-in-sequence.
Richard M. Stallman <rms@gnu.org>
parents: 3901
diff changeset
222 (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
223 "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
224 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
225 just after the binding for the event AFTER, instead of at the beginning
16556
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
226 of the map. Note that AFTER must be an event type (like KEY), NOT a command
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
227 \(like DEFINITION).
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
228
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
229 If AFTER is t, the new binding goes at the end of the keymap.
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
230
6725
e044bd05a1da (define-key-after): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 6553
diff changeset
231 KEY must contain just one event type--that is to say, it must be
16556
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
232 a string or vector of length 1.
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
233
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
234 The order of bindings in a keymap matters when it is used as a menu."
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
235
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
236 (or (keymapp keymap)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
237 (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
238 (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
239 (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
240 (let ((tail keymap) done inserted
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
241 (first (aref key 0)))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
242 (while (and (not done) tail)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
243 ;; 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
244 (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
245 (setcdr tail (cdr (cdr tail))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
246 ;; 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
247 ;; 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
248 ;; If we reach the end of this keymap, insert at the end.
16556
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
249 (if (or (and (eq (car-safe (car tail)) after)
3a1df67c6677 (define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents: 16549
diff changeset
250 (not (eq after t)))
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
251 (eq (car (cdr tail)) 'keymap)
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
252 (null (cdr tail)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
253 (progn
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
254 ;; 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
255 ;; 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
256 ;; 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
257 (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
258 (setq done t))
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
259 ;; 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
260 (or inserted
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
261 (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
262 (setq inserted t)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
263 (setq tail (cdr tail)))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
264
17437
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
265 (defmacro kbd (keys)
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
266 "Convert KEYS to the internal Emacs key representation.
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
267 KEYS should be a string constant in the format used for
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
268 saving keyboard macros (see `insert-kbd-macro')."
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
269 (read-kbd-macro keys))
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
270
15894
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
271 (put 'keyboard-translate-table 'char-table-extra-slots 0)
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
272
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
273 (defun keyboard-translate (from to)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
274 "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
275 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
276 and then modifies one entry in it."
15894
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
277 (or (char-table-p keyboard-translate-table)
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
278 (setq keyboard-translate-table
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
279 (make-char-table 'keyboard-translate-table nil)))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
280 (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
281
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
282
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
283 ;;;; The global keymap tree.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
284
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
285 ;;; 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
286 ;;; 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
287
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
288 (defvar global-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
289 "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
290 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
291 global map.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
292
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
293 (defvar esc-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
294 "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
295 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
296
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
297 (defvar ctl-x-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
298 "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
299 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
300
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
301 (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
302 "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
303 (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
304 (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
305
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
306 (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
307 "Keymap for frame commands.")
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
308 (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
309 (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
310
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
311
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
312 ;;;; Event manipulation functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
313
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
314 ;; The call to `read' is to ensure that the value is computed at load time
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
315 ;; and not compiled into the .elc file. The value is negative on most
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
316 ;; machines, but not on all!
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
317 (defconst listify-key-sequence-1 (logior 128 (read "?\\M-\\^@")))
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
318
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
319 (defun listify-key-sequence (key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
320 "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
321 (if (vectorp key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
322 (append key nil)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
323 (mapcar (function (lambda (c)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
324 (if (> c 127)
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
325 (logxor c listify-key-sequence-1)
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
326 c)))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
327 (append key nil))))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
328
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
329 (defsubst eventp (obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
330 "True if the argument is an event object."
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
331 (or (integerp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
332 (and (symbolp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
333 (get obj 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
334 (and (consp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
335 (symbolp (car obj))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
336 (get (car obj) 'event-symbol-elements))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
337
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
338 (defun event-modifiers (event)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
339 "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
340 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
341 `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
342 and `down'."
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
343 (let ((type event))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
344 (if (listp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
345 (setq type (car type)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
346 (if (symbolp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
347 (cdr (get type 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
348 (let ((list nil))
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
349 (or (zerop (logand type ?\M-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
350 (setq list (cons 'meta list)))
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
351 (or (and (zerop (logand type ?\C-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
352 (>= (logand type 127) 32))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
353 (setq list (cons 'control list)))
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
354 (or (and (zerop (logand type ?\S-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
355 (= (logand type 255) (downcase (logand type 255))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
356 (setq list (cons 'shift list)))
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
357 (or (zerop (logand type ?\H-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
358 (setq list (cons 'hyper list)))
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
359 (or (zerop (logand type ?\s-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
360 (setq list (cons 'super list)))
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
361 (or (zerop (logand type ?\A-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
362 (setq list (cons 'alt list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
363 list))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
364
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
365 (defun event-basic-type (event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
366 "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
367 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
368 (if (consp event)
d2df5ca46b39 * subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
369 (setq event (car event)))
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
370 (if (symbolp event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
371 (car (get event 'event-symbol-elements))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
372 (let ((base (logand event (1- (lsh 1 18)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
373 (downcase (if (< base 32) (logior base 64) base)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
374
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
375 (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
376 "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
377 (and (consp object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
378 (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
379
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
380 (defsubst event-start (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
381 "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
382 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
383 of the event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
384 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
385 The return value is of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
386 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
387 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
388 (nth 1 event))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
389
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
390 (defsubst event-end (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
391 "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
392 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
393 The return value is of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
394 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
395 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
396 (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
397
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
398 (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
399 "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
400 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
401 (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
402
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
403 (defsubst posn-window (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
404 "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
405 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
406 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
407 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
408 (nth 0 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
409
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
410 (defsubst posn-point (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
411 "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
412 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
413 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
414 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
415 (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
416 (car (nth 1 position))
ad2bd545983e * subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents: 3927
diff changeset
417 (nth 1 position)))
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
418
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
419 (defsubst posn-x-y (position)
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
420 "Return the x and y coordinates in POSITION.
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
421 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
422 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
423 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
424 (nth 2 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
425
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
426 (defun posn-col-row (position)
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
427 "Return the column and row in POSITION, measured in characters.
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
428 POSITION should be a list of the form
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
429 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
430 as returned by the `event-start' and `event-end' functions.
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
431 For a scroll-bar event, the result column is 0, and the row
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
432 corresponds to the vertical position of the click in the scroll bar."
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
433 (let ((pair (nth 2 position))
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
434 (window (posn-window position)))
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
435 (if (eq (if (consp (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
436 (car (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
437 (nth 1 position))
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
438 'vertical-scroll-bar)
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
439 (cons 0 (scroll-bar-scale pair (1- (window-height window))))
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
440 (if (eq (if (consp (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
441 (car (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
442 (nth 1 position))
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
443 'horizontal-scroll-bar)
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
444 (cons (scroll-bar-scale pair (window-width window)) 0)
7640
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
445 (let* ((frame (if (framep window) window (window-frame window)))
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
446 (x (/ (car pair) (frame-char-width frame)))
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
447 (y (/ (cdr pair) (frame-char-height frame))))
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
448 (cons x y))))))
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
449
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
450 (defsubst posn-timestamp (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
451 "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
452 POSITION should be a list of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
453 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
3411
d91b3097bb76 (posn-timestamp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3210
diff changeset
454 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
455 (nth 3 position))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
456
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
457
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
458 ;;;; Obsolescent names for functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
459
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
460 (defalias 'dot 'point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
461 (defalias 'dot-marker 'point-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
462 (defalias 'dot-min 'point-min)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
463 (defalias 'dot-max 'point-max)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
464 (defalias 'window-dot 'window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
465 (defalias 'set-window-dot 'set-window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
466 (defalias 'read-input 'read-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
467 (defalias 'send-string 'process-send-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
468 (defalias 'send-region 'process-send-region)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
469 (defalias 'show-buffer 'set-window-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
470 (defalias 'buffer-flush-undo 'buffer-disable-undo)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
471 (defalias 'eval-current-buffer 'eval-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
472 (defalias 'compiled-function-p 'byte-code-function-p)
16437
0626ef653e3e (define-function): Define as alias for defalias.
Richard M. Stallman <rms@gnu.org>
parents: 16379
diff changeset
473 (defalias 'define-function 'defalias)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
474
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
475 ;; 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
476 (defun baud-rate ()
3210
3176c6395ada (baud-rate): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3153
diff changeset
477 "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
478 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
479 baud-rate)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
480
15599
7d3af2dcd864 (unfocus-frame, focus-frame): Define as no-ops.
Miles Bader <miles@gnu.org>
parents: 14707
diff changeset
481 (defalias 'focus-frame 'ignore)
7d3af2dcd864 (unfocus-frame, focus-frame): Define as no-ops.
Miles Bader <miles@gnu.org>
parents: 14707
diff changeset
482 (defalias 'unfocus-frame 'ignore)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
483
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
484 ;;;; 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
485
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
486 (defalias 'string= 'string-equal)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
487 (defalias 'string< 'string-lessp)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
488 (defalias 'move-marker 'set-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
489 (defalias 'not 'null)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
490 (defalias 'rplaca 'setcar)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
491 (defalias 'rplacd 'setcdr)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3411
diff changeset
492 (defalias 'beep 'ding) ;preserve lingual purity
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
493 (defalias 'indent-to-column 'indent-to)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
494 (defalias 'backward-delete-char 'delete-backward-char)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
495 (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
496 (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
497 (defalias 'int-to-string 'number-to-string)
6551
99ca8123a3ca (set-match-data): New alias.
Richard M. Stallman <rms@gnu.org>
parents: 6441
diff changeset
498 (defalias 'set-match-data 'store-match-data)
1903
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
499
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
500 ;;; 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
501 ;;; 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
502 (defalias 'string-to-int 'string-to-number)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
503
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
504 ;;;; Hook manipulation functions.
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
505
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
506 (defun make-local-hook (hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
507 "Make the hook HOOK local to the current buffer.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
508 When a hook is local, its local and global values
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
509 work in concert: running the hook actually runs all the hook
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
510 functions listed in *either* the local value *or* the global value
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
511 of the hook variable.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
512
12258
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
513 This function works by making `t' a member of the buffer-local value,
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
514 which acts as a flag to run the hook functions in the default value as
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
515 well. This works for all normal hooks, but does not work for most
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
516 non-normal hooks yet. We will be changing the callers of non-normal
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
517 hooks so that they can handle localness; this has to be done one by
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
518 one.
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
519
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
520 This function does nothing if HOOK is already local in the current
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
521 buffer.
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
522
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
523 Do not use `make-local-variable' to make a hook variable buffer-local."
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
524 (if (local-variable-p hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
525 nil
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
526 (or (boundp hook) (set hook nil))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
527 (make-local-variable hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
528 (set hook (list t))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
529
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
530 (defun add-hook (hook function &optional append local)
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
531 "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
532 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
533 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
534 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
535 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
536
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
537 The optional fourth argument, LOCAL, if non-nil, says to modify
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
538 the hook's buffer-local value rather than its default value.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
539 This makes no difference if the hook is not buffer-local.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
540 To make a hook variable buffer-local, always use
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
541 `make-local-hook', not `make-local-variable'.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
542
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
543 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
544 HOOK is void, it is first set to nil. If HOOK's value is a single
8959
d33302427a47 (remove-hook, add-hook): Copy existing list before modifying.
Richard M. Stallman <rms@gnu.org>
parents: 8928
diff changeset
545 function, it is changed to a list of functions."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
546 (or (boundp hook) (set hook nil))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
547 (or (default-boundp hook) (set-default hook nil))
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
548 ;; 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
549 (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
550 (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
551 (set hook (list old))))
9202
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
552 (if (or local
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
553 ;; Detect the case where make-local-variable was used on a hook
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
554 ;; and do what we used to do.
12296
005a5b596618 (add-hook): Use local local-variable-if-set-p.
Richard M. Stallman <rms@gnu.org>
parents: 12258
diff changeset
555 (and (local-variable-if-set-p hook)
9202
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
556 (not (memq t (symbol-value hook)))))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
557 ;; Alter the local value only.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
558 (or (if (consp function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
559 (member function (symbol-value hook))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
560 (memq function (symbol-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
561 (set hook
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
562 (if append
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
563 (append (symbol-value hook) (list function))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
564 (cons function (symbol-value hook)))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
565 ;; Alter the global value (which is also the only value,
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
566 ;; if the hook doesn't have a local value).
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
567 (or (if (consp function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
568 (member function (default-value hook))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
569 (memq function (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
570 (set-default hook
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
571 (if append
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
572 (append (default-value hook) (list function))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
573 (cons function (default-value hook)))))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
574
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
575 (defun remove-hook (hook function &optional local)
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
576 "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
577 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
578 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
579 list of hooks to run in HOOK, then nothing is done. See `add-hook'.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
580
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
581 The optional third argument, LOCAL, if non-nil, says to modify
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
582 the hook's buffer-local value rather than its default value.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
583 This makes no difference if the hook is not buffer-local.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
584 To make a hook variable buffer-local, always use
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
585 `make-local-hook', not `make-local-variable'."
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
586 (if (or (not (boundp hook)) ;unbound symbol, or
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
587 (not (default-boundp 'hook))
4964
78c13f3054e5 (remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents: 4767
diff changeset
588 (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
589 (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
590 nil ;Do nothing.
9202
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
591 (if (or local
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
592 ;; Detect the case where make-local-variable was used on a hook
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
593 ;; and do what we used to do.
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
594 (and (local-variable-p hook)
92d6de82426a (add-hook, remove-hook): If the hook was made local
Richard M. Stallman <rms@gnu.org>
parents: 9195
diff changeset
595 (not (memq t (symbol-value hook)))))
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
596 (let ((hook-value (symbol-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
597 (if (consp hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
598 (if (member function hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
599 (setq hook-value (delete function (copy-sequence hook-value))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
600 (if (equal hook-value function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
601 (setq hook-value nil)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
602 (set hook hook-value))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
603 (let ((hook-value (default-value hook)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
604 (if (consp hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
605 (if (member function hook-value)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
606 (setq hook-value (delete function (copy-sequence hook-value))))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
607 (if (equal hook-value function)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
608 (setq hook-value nil)))
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
609 (set-default hook hook-value)))))
9510
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
610
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
611 (defun add-to-list (list-var element)
9535
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
612 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
13812
fdbace398b5e (add-to-list): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 13186
diff changeset
613 The test for presence of ELEMENT is done with `equal'.
9535
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
614 If you want to use `add-to-list' on a variable that is not defined
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
615 until a certain package is loaded, you should put the call to `add-to-list'
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
616 into a hook function that will be run only after loading the package.
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
617 `eval-after-load' provides one way to do this. In some cases
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
618 other hooks, such as major mode hooks, can do the job."
9510
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
619 (or (member element (symbol-value list-var))
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
620 (set list-var (cons element (symbol-value list-var)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
621
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
622 ;;;; 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
623
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
624 (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
625 "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
626 This makes or adds to an entry on `after-load-alist'.
10794
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
627 If FILE is already loaded, evaluate FORM right now.
5440
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
628 It does nothing if FORM is already on the list for FILE.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
629 FILE should be the name of a library, with no directory name."
10794
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
630 ;; Make sure there is an element for FILE.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
631 (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
632 (setq after-load-alist (cons (list file) after-load-alist)))
10794
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
633 ;; Add FORM to the element if it isn't there.
5440
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
634 (let ((elt (assoc file after-load-alist)))
856ecdc5228a (eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents: 5421
diff changeset
635 (or (member form (cdr elt))
10794
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
636 (progn
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
637 (nconc elt (list form))
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
638 ;; If the file has been loaded already, run FORM right away.
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
639 (and (assoc file load-history)
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
640 (eval form)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
641 form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
642
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
643 (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
644 "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
645 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
646 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
647 (eval-after-load file (read)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
648
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
649
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
650 ;;;; Input and display facilities.
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 read-quoted-char (&optional prompt)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
653 "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
654 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
655 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
656 Optional argument PROMPT specifies a string to use to prompt the user."
10681
14d924cf1114 (read-quoted-char): Don't log prompt messages.
Karl Heuer <kwzh@gnu.org>
parents: 10586
diff changeset
657 (let ((message-log-max nil) (count 0) (code 0) char)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
658 (while (< count 3)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
659 (let ((inhibit-quit (zerop count))
12108
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
660 ;; Don't let C-h get the help message--only help function keys.
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
661 (help-char nil)
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
662 (help-form
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
663 "Type the special character you want to use,
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
664 or three octal digits representing its character code."))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
665 (and prompt (message "%s-" prompt))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
666 (setq char (read-char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
667 (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
668 (cond ((null char))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
669 ((and (<= ?0 char) (<= char ?7))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
670 (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
671 count (1+ count))
14343
ab021899d604 (read-quoted-char): Delete format call inside message.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
672 (and prompt (setq prompt (message "%s %c" prompt char))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
673 ((> count 0)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
674 (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
675 (t (setq code char count 259))))
6838
ff8e7580e32d (read-quoted-char): Convert meta chars into 128+ chars.
Richard M. Stallman <rms@gnu.org>
parents: 6795
diff changeset
676 ;; Turn a meta-character into a character with the 0200 bit set.
10681
14d924cf1114 (read-quoted-char): Don't log prompt messages.
Karl Heuer <kwzh@gnu.org>
parents: 10586
diff changeset
677 (logior (if (/= (logand code ?\M-\^@) 0) 128 0)
17707
857918bf965f (read-quoted-char): Don't mask down to 8 bits.
Richard M. Stallman <rms@gnu.org>
parents: 17612
diff changeset
678 code)))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
679
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
680 (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
681 "Force the mode-line of the current buffer to be redisplayed.
6795
a379e974be7c (force-mode-line-update): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 6725
diff changeset
682 With optional non-nil ALL, force redisplay of all mode-lines."
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
683 (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
684 (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
685
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
686 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
687 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
688 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
689 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
690 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
691 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
692 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
693 (or exit-char (setq exit-char ?\ ))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
694 (let ((buffer-read-only nil)
6553
fca6271b0983 (momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents: 6551
diff changeset
695 ;; Don't modify the undo list at all.
fca6271b0983 (momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents: 6551
diff changeset
696 (buffer-undo-list t)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
697 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
698 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
699 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
700 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
701 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
702 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
703 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
704 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
705 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
706 (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
707 (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
708 ;; 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
709 (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
710 (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
711 ;; 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
712 ;; 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
713 (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
714 (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
715 (progn
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
716 (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
717 (recenter 0))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
718 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
719 (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
720 (let ((char (read-event)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
721 (or (eq char exit-char)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1695
diff changeset
722 (setq unread-command-events (list char)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
723 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
724 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
725 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
726 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
727 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
728
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
729
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
730 ;;;; Miscellanea.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
731
10254
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
732 ;; A number of major modes set this locally.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
733 ;; Give it a global value to avoid compiler warnings.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
734 (defvar font-lock-defaults nil)
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
735
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
736 ;; Avoid compiler warnings about this variable,
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
737 ;; which has a special meaning on certain system types.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
738 (defvar buffer-file-type nil
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
739 "Non-nil if the visited file is a binary file.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
740 This variable is meaningful on MS-DOG and Windows NT.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
741 On those systems, it is automatically local in every buffer.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
742 On other systems, this variable is normally always nil.")
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
743
14515
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
744 ;; This should probably be written in C (i.e., without using `walk-windows').
14707
ddcae263bb18 Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents: 14517
diff changeset
745 (defun get-buffer-window-list (buffer &optional minibuf frame)
14515
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
746 "Return windows currently displaying BUFFER, or nil if none.
14707
ddcae263bb18 Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents: 14517
diff changeset
747 See `walk-windows' for the meaning of MINIBUF and FRAME."
14517
8b88e5c2a6d5 Cope if get-buffer-window-list is given a buffer name (like get-buffer-window does).
Simon Marshall <simon@gnu.org>
parents: 14515
diff changeset
748 (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
14515
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
749 (walk-windows (function (lambda (window)
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
750 (if (eq (window-buffer window) buffer)
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
751 (setq windows (cons window windows)))))
14707
ddcae263bb18 Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents: 14517
diff changeset
752 minibuf frame)
14515
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
753 windows))
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
754
8211
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
755 (defun ignore (&rest ignore)
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
756 "Do nothing and return nil.
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
757 This function accepts any number of arguments, but ignores them."
7400
c415ff549eed (ignore): Allow interactive call.
Richard M. Stallman <rms@gnu.org>
parents: 7298
diff changeset
758 (interactive)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
759 nil)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
760
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
761 (defun error (&rest args)
13936
24ff5e49ac27 (error): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13812
diff changeset
762 "Signal an error, making error message by passing all args to `format'.
24ff5e49ac27 (error): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13812
diff changeset
763 In Emacs, the convention is that error messages start with a capital
24ff5e49ac27 (error): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13812
diff changeset
764 letter but *do not* end with a period. Please follow this convention
24ff5e49ac27 (error): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13812
diff changeset
765 for the sake of consistency."
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
766 (while t
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
767 (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
768
5912
909b94d547c4 (user-original-login-name): Reduce to a defalias, since it's redundant with
Karl Heuer <kwzh@gnu.org>
parents: 5844
diff changeset
769 (defalias 'user-original-login-name 'user-login-name)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
770
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
771 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
772 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
773 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
774 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
775 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
776 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
777 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
778 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
779 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
780 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
781 Remaining arguments are the arguments for the command.
5460
3bd42ee22d1f (start-process-shell-command): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 5440
diff changeset
782 Wildcards and redirection are handled as usual in the shell."
9822
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
783 (cond
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
784 ((eq system-type 'vax-vms)
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
785 (apply 'start-process name buffer args))
10025
3b058e13d177 (start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents: 9986
diff changeset
786 ;; We used to use `exec' to replace the shell with the command,
3b058e13d177 (start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents: 9986
diff changeset
787 ;; but that failed to handle (...) and semicolon, etc.
9822
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
788 (t
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
789 (start-process name buffer shell-file-name shell-command-switch
10025
3b058e13d177 (start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents: 9986
diff changeset
790 (mapconcat 'identity args " ")))))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
791
16277
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
792 (defmacro with-current-buffer (buffer &rest body)
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
793 "Execute the forms in BODY with BUFFER as the current buffer.
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
794 The value returned is the value of the last form in BODY.
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
795 See also `with-temp-buffer'."
16277
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
796 `(save-current-buffer
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
797 (set-buffer ,buffer)
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
798 ,@body))
16277
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
799
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
800 (defmacro with-temp-file (file &rest forms)
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
801 "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
802 The value of the last form in FORMS is returned, like `progn'.
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
803 See also `with-temp-buffer'."
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
804 (let ((temp-file (make-symbol "temp-file"))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
805 (temp-buffer (make-symbol "temp-buffer")))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
806 `(let ((,temp-file ,file)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
807 (,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
808 (get-buffer-create (generate-new-buffer-name " *temp file*"))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
809 (unwind-protect
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
810 (prog1
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
811 (with-current-buffer ,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
812 ,@forms)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
813 (with-current-buffer ,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
814 (widen)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
815 (write-region (point-min) (point-max) ,temp-file nil 0)))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
816 (and (buffer-name ,temp-buffer)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
817 (kill-buffer ,temp-buffer))))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
818
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
819 (defmacro with-temp-buffer (&rest forms)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
820 "Create a temporary buffer, and evaluate FORMS there like `progn'.
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
821 See also `with-temp-file' and `with-output-to-string'."
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
822 (let ((temp-buffer (make-symbol "temp-buffer")))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
823 `(let ((,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
824 (get-buffer-create (generate-new-buffer-name " *temp*"))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
825 (unwind-protect
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
826 (with-current-buffer ,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
827 ,@forms)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
828 (and (buffer-name ,temp-buffer)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
829 (kill-buffer ,temp-buffer))))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
830
16311
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
831 (defmacro with-output-to-string (&rest body)
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
832 "Execute BODY, return the text it sent to `standard-output', as a string."
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
833 `(let ((standard-output
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
834 (get-buffer-create (generate-new-buffer-name " *string-output*"))))
16311
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
835 (let ((standard-output standard-output))
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
836 ,@body)
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
837 (with-current-buffer standard-output
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
838 (prog1
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
839 (buffer-string)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
840 (kill-buffer nil)))))
16549
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
841
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
842 (defmacro combine-after-change-calls (&rest body)
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
843 "Execute BODY, but don't call the after-change functions till the end.
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
844 If BODY makes changes in the buffer, they are recorded
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
845 and the functions on `after-change-functions' are called several times
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
846 when BODY is finished.
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
847 The return value is the value of the last form in BODY.
16549
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
848
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
849 If `before-change-functions' is non-nil, then calls to the after-change
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
850 functions can't be deferred, so in that case this macro has no effect.
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
851
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
852 Do not alter `after-change-functions' or `before-change-functions'
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
853 in BODY."
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
854 `(unwind-protect
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
855 (let ((combine-after-change-calls t))
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
856 . ,body)
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
857 (combine-after-change-execute)))
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
858
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
859
15955
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
860 (defvar save-match-data-internal)
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
861
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
862 ;; We use save-match-data-internal as the local variable because
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
863 ;; that works ok in practice (people should not use that variable elsewhere).
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
864 ;; We used to use an uninterned symbol; the compiler handles that properly
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
865 ;; now, but it generates slower code.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
866 (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
867 "Execute the BODY forms, restoring the global value of the match data."
15983
9a41bae14122 (save-match-data): Fix typo in previous change.
Richard M. Stallman <rms@gnu.org>
parents: 15965
diff changeset
868 `(let ((save-match-data-internal (match-data)))
15955
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
869 (unwind-protect
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
870 (progn ,@body)
15965
daebc0d7f610 (save-match-data): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 15955
diff changeset
871 (store-match-data save-match-data-internal))))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
872
11115
9414f249cd8b Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents: 11101
diff changeset
873 (defun match-string (num &optional string)
11101
67231dca5f32 Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents: 11087
diff changeset
874 "Return string of text matched by last search.
67231dca5f32 Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents: 11087
diff changeset
875 NUM specifies which parenthesized expression in the last regexp.
67231dca5f32 Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents: 11087
diff changeset
876 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
67231dca5f32 Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents: 11087
diff changeset
877 Zero means the entire text matched by the whole regexp or whole string.
67231dca5f32 Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents: 11087
diff changeset
878 STRING should be given if the last search was by `string-match' on STRING."
11115
9414f249cd8b Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents: 11101
diff changeset
879 (if (match-beginning num)
9414f249cd8b Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents: 11101
diff changeset
880 (if string
9414f249cd8b Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents: 11101
diff changeset
881 (substring string (match-beginning num) (match-end num))
9414f249cd8b Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents: 11101
diff changeset
882 (buffer-substring (match-beginning num) (match-end num)))))
10560
fd09d51dfd77 (match-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10368
diff changeset
883
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
884 (defun split-string (string &optional separators)
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
885 "Splits STRING into substrings where there are matches for SEPARATORS.
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
886 Each match for SEPARATORS is a splitting point.
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
887 The substrings between the splitting points are made into a list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
888 which is returned.
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
889 If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
890 (let ((rexp (or separators "[ \f\t\n\r\v]+"))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
891 (start 0)
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
892 (list nil))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
893 (while (string-match rexp string start)
16333
585956e62c87 (split-string): Fix minor bug.
Richard M. Stallman <rms@gnu.org>
parents: 16314
diff changeset
894 (or (eq (match-beginning 0) 0)
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
895 (setq list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
896 (cons (substring string start (match-beginning 0))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
897 list)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
898 (setq start (match-end 0)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
899 (or (eq start (length string))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
900 (setq list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
901 (cons (substring string start)
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
902 list)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
903 (nreverse list)))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
904
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
905 (defun shell-quote-argument (argument)
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
906 "Quote an argument for passing as argument to an inferior shell."
12465
0d404ef125ea (shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents: 12395
diff changeset
907 (if (eq system-type 'ms-dos)
0d404ef125ea (shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents: 12395
diff changeset
908 ;; MS-DOS shells don't have quoting, so don't do any.
0d404ef125ea (shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents: 12395
diff changeset
909 argument
0d404ef125ea (shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents: 12395
diff changeset
910 (if (eq system-type 'windows-nt)
0d404ef125ea (shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents: 12395
diff changeset
911 (concat "\"" argument "\"")
17610
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
912 (if (equal argument "")
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
913 "''"
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
914 ;; Quote everything except POSIX filename characters.
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
915 ;; This should be safe enough even for really weird shells.
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
916 (let ((result "") (start 0) end)
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
917 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
918 (setq end (match-beginning 0)
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
919 result (concat result (substring argument start end)
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
920 "\\" (substring argument end (1+ end)))
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
921 start (1+ end)))
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
922 (concat result (substring argument start)))))))
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
923
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
924 (defun make-syntax-table (&optional oldtable)
5421
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
925 "Return a new syntax table.
17612
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
926 If OLDTABLE is non-nil, copy OLDTABLE.
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
927 Otherwise, create a syntax table which inherits
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
928 all letters and control characters from the standard syntax table;
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
929 other characters are copied from the standard syntax table."
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
930 (if oldtable
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
931 (copy-syntax-table oldtable)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
932 (let ((table (copy-syntax-table))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
933 i)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
934 (setq i 0)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
935 (while (<= i 31)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
936 (aset table i nil)
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
937 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
938 (setq i ?A)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
939 (while (<= i ?Z)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
940 (aset table i nil)
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
941 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
942 (setq i ?a)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
943 (while (<= i ?z)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
944 (aset table i nil)
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
945 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
946 (setq i 128)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
947 (while (<= i 255)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
948 (aset table i nil)
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
949 (setq i (1+ i)))
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
950 table)))
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
951
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
952 (defun add-to-invisibility-spec (arg)
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
953 "Add elements to `buffer-invisibility-spec'.
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
954 See documentation for `buffer-invisibility-spec' for the kind of elements
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
955 that can be added."
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
956 (cond
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
957 ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t))
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
958 (setq buffer-invisibility-spec (list arg)))
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
959 (t
17158
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
960 (setq buffer-invisibility-spec
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
961 (cons arg buffer-invisibility-spec)))))
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
962
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
963 (defun remove-from-invisibility-spec (arg)
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
964 "Remove elements from `buffer-invisibility-spec'."
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
965 (if buffer-invisibility-spec
17152
3c55ec545afb Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 17146
diff changeset
966 (setq buffer-invisibility-spec (delete arg buffer-invisibility-spec))))
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
967
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
968 (defun global-set-key (key command)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
969 "Give KEY a global binding as COMMAND.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
970 COMMAND is a symbol naming an interactively-callable function.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
971 KEY is a key sequence (a string or vector of characters or event types).
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
972 Non-ASCII characters with codes above 127 (such as ISO Latin-1)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
973 can be included if you use a vector.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
974 Note that if KEY has a local binding in the current buffer
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
975 that local binding will continue to shadow any global binding."
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
976 (interactive "KSet key globally: \nCSet key %s to command: ")
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
977 (or (vectorp key) (stringp key)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
978 (signal 'wrong-type-argument (list 'arrayp key)))
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
979 (define-key (current-global-map) key command)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
980 nil)
5421
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
981
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
982 (defun local-set-key (key command)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
983 "Give KEY a local binding as COMMAND.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
984 COMMAND is a symbol naming an interactively-callable function.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
985 KEY is a key sequence (a string or vector of characters or event types).
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
986 Non-ASCII characters with codes above 127 (such as ISO Latin-1)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
987 can be included if you use a vector.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
988 The binding goes in the current buffer's local map,
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
989 which in most cases is shared with all other buffers in the same major mode."
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
990 (interactive "KSet key locally: \nCSet key %s locally to command: ")
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
991 (let ((map (current-local-map)))
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
992 (or map
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
993 (use-local-map (setq map (make-sparse-keymap))))
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
994 (or (vectorp key) (stringp key)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
995 (signal 'wrong-type-argument (list 'arrayp key)))
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
996 (define-key map key command))
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
997 nil)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
998
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
999 (defun global-unset-key (key)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1000 "Remove global binding of KEY.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1001 KEY is a string representing a sequence of keystrokes."
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1002 (interactive "kUnset key globally: ")
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1003 (global-set-key key nil))
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1004
10826
bd0ab0601489 (local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 10825
diff changeset
1005 (defun local-unset-key (key)
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1006 "Remove local binding of KEY.
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1007 KEY is a string representing a sequence of keystrokes."
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1008 (interactive "kUnset key locally: ")
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1009 (if (current-local-map)
10826
bd0ab0601489 (local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 10825
diff changeset
1010 (local-set-key key nil))
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1011 nil)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1012
12016
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1013 ;; We put this here instead of in frame.el so that it's defined even on
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1014 ;; systems where frame.el isn't loaded.
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1015 (defun frame-configuration-p (object)
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1016 "Return non-nil if OBJECT seems to be a frame configuration.
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1017 Any list whose car is `frame-configuration' is assumed to be a frame
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1018 configuration."
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1019 (and (consp object)
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1020 (eq (car object) 'frame-configuration)))
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1021
17418
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1022 (defun functionp (object)
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1023 "Non-nil of OBJECT is a type of object that can be called as a function."
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1024 (or (subrp object) (compiled-function-p object)
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1025 (eq (car-safe object) 'lambda)
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1026 (and (symbolp object) (fboundp object))))
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1027
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1028 ;; now in fns.c
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1029 ;(defun nth (n list)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1030 ; "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
1031 ;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
1032 ; (car (nthcdr n list)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1033 ;
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1034 ;(defun copy-alist (alist)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1035 ; "Return a copy of ALIST.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1036 ;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
1037 ;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
1038 ;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
1039 ;are shared, however."
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1040 ; (setq alist (copy-sequence alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1041 ; (let ((tail alist))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1042 ; (while tail
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1043 ; (if (consp (car tail))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1044 ; (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
1045 ; (setq tail (cdr tail))))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1046 ; alist)
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
1047
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
1048 ;;; subr.el ends here