annotate lisp/subr.el @ 37070:838adca2d2fd

(interactive-form): Fix paren typo.
author Miles Bader <miles@gnu.org>
date Fri, 30 Mar 2001 00:52:54 +0000
parents 4cb750b910d1
children 67b464da13ec
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
36094
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
3 ;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
4 ;; Free Software Foundation, Inc.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
5
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
6 ;; This file is part of GNU Emacs.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
7
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
8 ;; GNU Emacs is free software; you can redistribute it and/or modify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
9 ;; 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
10 ;; the Free Software Foundation; either version 2, or (at your option)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
11 ;; any later version.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
12
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
13 ;; GNU Emacs is distributed in the hope that it will be useful,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
16 ;; GNU General Public License for more details.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
17
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
18 ;; 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
19 ;; 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
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
83f275dcd93a Update FSF's address.
Erik Naggum <erik@naggum.no>
parents: 13936
diff changeset
21 ;; Boston, MA 02111-1307, USA.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
22
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
23 ;;; Code:
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
24 (defvar custom-declare-variable-list nil
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
25 "Record `defcustom' calls made before `custom.el' is loaded to handle them.
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
26 Each element of this list holds the arguments to one call to `defcustom'.")
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
27
19662
791a40c16c0b Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 19584
diff changeset
28 ;; Use this, rather than defcustom, in subr.el and other files loaded
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
29 ;; before custom.el.
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
30 (defun custom-declare-variable-early (&rest arguments)
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
31 (setq custom-declare-variable-list
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
32 (cons arguments custom-declare-variable-list)))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
33
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
34 ;;;; Lisp language features.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
35
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
36 (defmacro lambda (&rest cdr)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
37 "Return a lambda expression.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
38 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
39 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
40 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
41 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
42 funcall or mapcar, etc.
be0081d9ba76 (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10025
diff changeset
43
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
44 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
45 DOCSTRING is an optional documentation string.
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
46 If present, it should describe how to call the function.
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
47 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
48 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
49 It may also be omitted.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
50 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
51 ;; 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
52 ;; depend on backquote.el.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
53 (list 'function (cons 'lambda cdr)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
54
25437
95301c74bdd9 Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 25436
diff changeset
55 (defmacro push (newelt listname)
25580
b76f1a72649a (push): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 25469
diff changeset
56 "Add NEWELT to the list stored in the symbol LISTNAME.
25437
95301c74bdd9 Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 25436
diff changeset
57 This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)).
25436
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
58 LISTNAME must be a symbol."
25469
6762c8a75fd7 (push): Fix typo.
Dave Love <fx@gnu.org>
parents: 25437
diff changeset
59 (list 'setq listname
6762c8a75fd7 (push): Fix typo.
Dave Love <fx@gnu.org>
parents: 25437
diff changeset
60 (list 'cons newelt listname)))
25436
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
61
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
62 (defmacro pop (listname)
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
63 "Return the first element of LISTNAME's value, and remove it from the list.
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
64 LISTNAME must be a symbol whose value is a list.
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
65 If the value is nil, `pop' returns nil but does not actually
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
66 change the list."
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
67 (list 'prog1 (list 'car listname)
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
68 (list 'setq listname (list 'cdr listname))))
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
69
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
70 (defmacro when (cond &rest body)
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
71 "If COND yields non-nil, do BODY, else return nil."
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
72 (list 'if cond (cons 'progn body)))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
73
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
74 (defmacro unless (cond &rest body)
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
75 "If COND yields nil, do BODY, else return nil."
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
76 (cons 'if (cons cond (cons nil body))))
19491
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
77
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
78 (defmacro dolist (spec &rest body)
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
79 "(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
80 Evaluate BODY with VAR bound to each car from LIST, in turn.
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
81 Then evaluate RESULT to get return value, default nil."
27383
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
82 (let ((temp (make-symbol "--dolist-temp--")))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
83 (list 'let (list (list temp (nth 1 spec)) (car spec))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
84 (list 'while temp
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
85 (list 'setq (car spec) (list 'car temp))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
86 (cons 'progn
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
87 (append body
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
88 (list (list 'setq temp (list 'cdr temp))))))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
89 (if (cdr (cdr spec))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
90 (cons 'progn
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
91 (cons (list 'setq (car spec) nil) (cdr (cdr spec))))))))
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
92
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
93 (defmacro dotimes (spec &rest body)
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
94 "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
95 Evaluate BODY with VAR bound to successive integers running from 0,
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
96 inclusive, to COUNT, exclusive. Then evaluate RESULT to get
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
97 the return value (nil if RESULT is omitted)."
27383
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
98 (let ((temp (make-symbol "--dotimes-temp--")))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
99 (list 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
100 (list 'while (list '< (car spec) temp)
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
101 (cons 'progn
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
102 (append body (list (list 'setq (car spec)
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
103 (list '1+ (car spec)))))))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
104 (if (cdr (cdr spec))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
105 (car (cdr (cdr spec)))
b1b3e778f7ac Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents: 27376
diff changeset
106 nil))))
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
107
19491
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
108 (defsubst caar (x)
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
109 "Return the car of the car of X."
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
110 (car (car x)))
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
111
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
112 (defsubst cadr (x)
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
113 "Return the car of the cdr of X."
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
114 (car (cdr x)))
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
115
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
116 (defsubst cdar (x)
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
117 "Return the cdr of the car of X."
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
118 (cdr (car x)))
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
119
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
120 (defsubst cddr (x)
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
121 "Return the cdr of the cdr of X."
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
122 (cdr (cdr x)))
19492
892a09772457 (last): New function.
Richard M. Stallman <rms@gnu.org>
parents: 19491
diff changeset
123
19584
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
124 (defun last (x &optional n)
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
125 "Return the last link of the list X. Its car is the last element.
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
126 If X is nil, return nil.
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
127 If N is non-nil, return the Nth-to-last link of X.
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
128 If N is bigger than the length of X, return X."
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
129 (if n
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
130 (let ((m 0) (p x))
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
131 (while (consp p)
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
132 (setq m (1+ m) p (cdr p)))
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
133 (if (<= n 0) p
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
134 (if (< n m) (nthcdr (- m n) x) x)))
35281
be18bd846968 (last): Handle a list that doesn't end in nil.
Richard M. Stallman <rms@gnu.org>
parents: 35231
diff changeset
135 (while (consp (cdr x))
19584
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
136 (setq x (cdr x)))
17db1ee36bbb (last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents: 19492
diff changeset
137 x))
22860
349fa4ee1f27 (assoc-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 22755
diff changeset
138
34898
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
139 (defun butlast (x &optional n)
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
140 "Returns a copy of LIST with the last N elements removed."
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
141 (if (and n (<= n 0)) x
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
142 (nbutlast (copy-sequence x) n)))
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
143
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
144 (defun nbutlast (x &optional n)
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
145 "Modifies LIST to remove the last N elements."
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
146 (let ((m (length x)))
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
147 (or n (setq n 1))
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
148 (and (< n m)
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
149 (progn
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
150 (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
151 x))))
1486728b21f0 (butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents: 34853
diff changeset
152
30515
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
153 (defun remove (elt seq)
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
154 "Return a copy of SEQ with all occurences of ELT removed.
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
155 SEQ must be a list, vector, or string. The comparison is done with `equal'."
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
156 (if (nlistp seq)
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
157 ;; If SEQ isn't a list, there's no need to copy SEQ because
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
158 ;; `delete' will return a new object.
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
159 (delete elt seq)
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
160 (delete elt (copy-sequence seq))))
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
161
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
162 (defun remq (elt list)
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
163 "Return a copy of LIST with all occurences of ELT removed.
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
164 The comparison is done with `eq'."
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
165 (if (memq elt list)
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
166 (delq elt (copy-sequence list))
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
167 list))
6165183bc490 (remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents: 29354
diff changeset
168
22959
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
169 (defun assoc-default (key alist &optional test default)
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
170 "Find object KEY in a pseudo-alist ALIST.
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
171 ALIST is a list of conses or objects. Each element (or the element's car,
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
172 if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY).
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
173 If that is non-nil, the element matches;
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
174 then `assoc-default' returns the element's cdr, if it is a cons,
22860
349fa4ee1f27 (assoc-default): New function.
Richard M. Stallman <rms@gnu.org>
parents: 22755
diff changeset
175 or DEFAULT if the element is not a cons.
22959
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
176
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
177 If no element matches, the value is nil.
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
178 If TEST is omitted or nil, `equal' is used."
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
179 (let (found (tail alist) value)
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
180 (while (and tail (not found))
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
181 (let ((elt (car tail)))
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
182 (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
183 (setq found t value (if (consp elt) (cdr elt) default))))
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
184 (setq tail (cdr tail)))
73a21b5f9bd8 (assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents: 22860
diff changeset
185 value))
25295
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
186
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
187 (defun assoc-ignore-case (key alist)
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
188 "Like `assoc', but ignores differences in case and text representation.
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
189 KEY must be a string. Upper-case and lower-case letters are treated as equal.
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
190 Unibyte strings are converted to multibyte for comparison."
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
191 (let (element)
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
192 (while (and alist (not element))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
193 (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil t))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
194 (setq element (car alist)))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
195 (setq alist (cdr alist)))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
196 element))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
197
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
198 (defun assoc-ignore-representation (key alist)
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
199 "Like `assoc', but ignores differences in text representation.
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
200 KEY must be a string.
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
201 Unibyte strings are converted to multibyte for comparison."
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
202 (let (element)
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
203 (while (and alist (not element))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
204 (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
205 (setq element (car alist)))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
206 (setq alist (cdr alist)))
737e82c21934 (assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents: 25293
diff changeset
207 element))
28490
9958b6d95bd6 (member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28234
diff changeset
208
9958b6d95bd6 (member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28234
diff changeset
209 (defun member-ignore-case (elt list)
9958b6d95bd6 (member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28234
diff changeset
210 "Like `member', but ignores differences in case and text representation.
9958b6d95bd6 (member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28234
diff changeset
211 ELT must be a string. Upper-case and lower-case letters are treated as equal.
9958b6d95bd6 (member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28234
diff changeset
212 Unibyte strings are converted to multibyte for comparison."
33978
9aa3fd6779f7 (member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents: 33835
diff changeset
213 (while (and list (not (eq t (compare-strings elt 0 nil (car list) 0 nil t))))
9aa3fd6779f7 (member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents: 33835
diff changeset
214 (setq list (cdr list)))
9aa3fd6779f7 (member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents: 33835
diff changeset
215 list)
28490
9958b6d95bd6 (member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28234
diff changeset
216
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
217
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
218 ;;;; Keymap support.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
219
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
220 (defun undefined ()
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
221 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
222 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
223
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
224 ;Prevent the \{...} documentation construct
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
225 ;from mentioning keys that run this command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
226 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
227
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
228 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
229 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
230 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
231 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
232 (substitute-key-definition 'self-insert-command 'undefined map global-map)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
233 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
234 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
235 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
236 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
237 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
238 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
239 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
240 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
241
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
242 ;Moved to keymap.c
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
243 ;(defun copy-keymap (keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
244 ; "Return a copy of KEYMAP"
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
245 ; (while (not (keymapp keymap))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
246 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
247 ; (if (vectorp keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
248 ; (copy-sequence keymap)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
249 ; (copy-alist keymap)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
250
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
251 (defvar key-substitution-in-progress nil
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
252 "Used internally by substitute-key-definition.")
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
253
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
254 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
255 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
256 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
28811
8a7623ffeeac (substitute-key-definition): Clarify documentation.
Gerd Moellmann <gerd@gnu.org>
parents: 28794
diff changeset
257 Alternatively, if optional fourth argument OLDMAP is specified, we redefine
32131
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
258 in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP."
28868
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
259 ;; Don't document PREFIX in the doc string because we don't want to
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
260 ;; advertise it. It's meant for recursive calls only. Here's its
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
261 ;; meaning
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
262
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
263 ;; If optional argument PREFIX is specified, it should be a key
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
264 ;; prefix, a string. Redefined bindings will then be bound to the
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
265 ;; original key, with PREFIX added at the front.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
266 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
267 (let* ((scan (or oldmap keymap))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
268 (vec1 (vector nil))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
269 (prefix1 (vconcat prefix vec1))
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
270 (key-substitution-in-progress
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
271 (cons scan key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
272 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
273 ;; has any definition, and act on it with hack-key.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
274 (while (consp scan)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
275 (if (consp (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
276 (let ((char (car (car scan)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
277 (defn (cdr (car scan))))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
278 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
279 ;; the inside of the following let that handles array elements.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
280 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
281 (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
282 (let (inner-def skipped)
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
283 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
284 (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
285 (setq skipped (cons (car defn) skipped))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
286 (setq defn (cdr defn)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
287 ;; 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
288 (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
289 (setq defn (cdr defn)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
290 (setq inner-def defn)
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
291 ;; Look past a symbol that names a keymap.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
292 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
293 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
294 (setq inner-def (symbol-function inner-def)))
17215
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
295 (if (or (eq defn olddef)
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
296 ;; Compare with equal if definition is a key sequence.
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
297 ;; That is useful for operating on function-key-map.
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
298 (and (or (stringp defn) (vectorp defn))
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
299 (equal defn olddef)))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
300 (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
301 (if (and (keymapp defn)
9986
df605fcd1e75 (substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 9822
diff changeset
302 ;; Avoid recursively scanning
df605fcd1e75 (substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 9822
diff changeset
303 ;; 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
304 (let ((elt (lookup-key keymap prefix1)))
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
305 (or (null elt)
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
306 (keymapp elt)))
9986
df605fcd1e75 (substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 9822
diff changeset
307 ;; Avoid recursively rescanning keymap being scanned.
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
308 (not (memq inner-def
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
309 key-substitution-in-progress)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
310 ;; 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
311 ;; scan it now.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
312 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
313 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
314 prefix1)))))
18044
3e4924d01221 (substitute-key-definition): Check vectorp, not arrayp.
Richard M. Stallman <rms@gnu.org>
parents: 17943
diff changeset
315 (if (vectorp (car scan))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
316 (let* ((array (car scan))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
317 (len (length array))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
318 (i 0))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
319 (while (< i len)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
320 (let ((char i) (defn (aref array i)))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
321 ;; The inside of this let duplicates exactly
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
322 ;; the inside of the previous let.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
323 (aset vec1 0 char)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
324 (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
325 (let (inner-def skipped)
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
326 ;; Skip past menu-prompt.
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
327 (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
328 (setq skipped (cons (car defn) skipped))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
329 (setq defn (cdr defn)))
7615
49176059d040 (substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents: 7548
diff changeset
330 (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
331 (setq defn (cdr defn)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
332 (setq inner-def defn)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
333 (while (and (symbolp inner-def)
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
334 (fboundp inner-def))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
335 (setq inner-def (symbol-function inner-def)))
17215
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
336 (if (or (eq defn olddef)
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
337 (and (or (stringp defn) (vectorp defn))
21e3f467224e (substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents: 17158
diff changeset
338 (equal defn olddef)))
6005
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
339 (define-key keymap prefix1
bf1c9fd5669b (substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents: 5912
diff changeset
340 (nconc (nreverse skipped) newdef))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
341 (if (and (keymapp defn)
13039
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
342 (let ((elt (lookup-key keymap prefix1)))
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
343 (or (null elt)
04ffbdd37d2d (substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents: 12730
diff changeset
344 (keymapp elt)))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
345 (not (memq inner-def
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
346 key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
347 (substitute-key-definition olddef newdef keymap
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
348 inner-def
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
349 prefix1)))))
17922
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
350 (setq i (1+ i))))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
351 (if (char-table-p (car scan))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
352 (map-char-table
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
353 (function (lambda (char defn)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
354 (let ()
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
355 ;; The inside of this let duplicates exactly
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
356 ;; the inside of the previous let,
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
357 ;; except that it uses set-char-table-range
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
358 ;; instead of define-key.
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
359 (aset vec1 0 char)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
360 (aset prefix1 (length prefix) char)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
361 (let (inner-def skipped)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
362 ;; Skip past menu-prompt.
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
363 (while (stringp (car-safe defn))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
364 (setq skipped (cons (car defn) skipped))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
365 (setq defn (cdr defn)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
366 (and (consp defn) (consp (car defn))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
367 (setq defn (cdr defn)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
368 (setq inner-def defn)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
369 (while (and (symbolp inner-def)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
370 (fboundp inner-def))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
371 (setq inner-def (symbol-function inner-def)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
372 (if (or (eq defn olddef)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
373 (and (or (stringp defn) (vectorp defn))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
374 (equal defn olddef)))
17943
15dc805eadee (substitute-key-definition): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17922
diff changeset
375 (define-key keymap prefix1
15dc805eadee (substitute-key-definition): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 17922
diff changeset
376 (nconc (nreverse skipped) newdef))
17922
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
377 (if (and (keymapp defn)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
378 (let ((elt (lookup-key keymap prefix1)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
379 (or (null elt)
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
380 (keymapp elt)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
381 (not (memq inner-def
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
382 key-substitution-in-progress)))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
383 (substitute-key-definition olddef newdef keymap
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
384 inner-def
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
385 prefix1)))))))
29d58e05d603 (substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents: 17707
diff changeset
386 (car scan)))))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
387 (setq scan (cdr scan)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
388
27821
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
389 (defun define-key-after (keymap key definition &optional after)
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
390 "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
391 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
392 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
393 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
394 \(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
395
27821
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
396 If AFTER is t or omitted, the new binding goes at the end of the keymap.
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
397
27821
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
398 KEY must contain just one event type--that is to say, it must be a
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
399 string or vector of length 1, but AFTER should be a single event
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
400 type--a symbol or a character, not a sequence.
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
401
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
402 Bindings are always added before any inherited map.
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
403
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
404 The order of bindings in a keymap matters when it is used as a menu."
27821
5ef5616e8304 (define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents: 27810
diff changeset
405 (unless after (setq after t))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
406 (or (keymapp keymap)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
407 (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
408 (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
409 (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
410 (let ((tail keymap) done inserted
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
411 (first (aref key 0)))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
412 (while (and (not done) tail)
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
413 ;; 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
414 (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
415 (setcdr tail (cdr (cdr tail))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
416 ;; 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
417 ;; 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
418 ;; 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
419 (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
420 (not (eq after t)))
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
421 (eq (car (cdr tail)) 'keymap)
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
422 (null (cdr tail)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
423 (progn
3927
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
424 ;; 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
425 ;; 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
426 ;; 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
427 (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
428 (setq done t))
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
429 ;; 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
430 (or inserted
1f1fefc400ed (define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents: 3902
diff changeset
431 (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
432 (setq inserted t)))
3901
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
433 (setq tail (cdr tail)))))
c78753b7eea8 (define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 3860
diff changeset
434
17437
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
435 (defmacro kbd (keys)
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
436 "Convert KEYS to the internal Emacs key representation.
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
437 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
438 saving keyboard macros (see `insert-kbd-macro')."
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
439 (read-kbd-macro keys))
d7f9b21fdfd2 (kbd): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 17418
diff changeset
440
15894
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
441 (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
442
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
443 (defun keyboard-translate (from to)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
444 "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
445 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
446 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
447 (or (char-table-p keyboard-translate-table)
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
448 (setq keyboard-translate-table
efd2835a7c96 (keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents: 15599
diff changeset
449 (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
450 (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
451
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
452
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
453 ;;;; The global keymap tree.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
454
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
455 ;;; 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
456 ;;; 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
457
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
458 (defvar global-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
459 "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
460 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
461 global map.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
462
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
463 (defvar esc-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
464 "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
465 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
466
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
467 (defvar ctl-x-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
468 "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
469 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
470
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
471 (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
472 "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
473 (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
474 (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
475
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
476 (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
477 "Keymap for frame commands.")
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
478 (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
479 (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
480
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
481
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
482 ;;;; Event manipulation functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
483
10693
0875851842f0 (listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents: 10681
diff changeset
484 ;; 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
485 ;; 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
486 ;; 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
487 (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
488
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
489 (defun listify-key-sequence (key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
490 "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
491 (if (vectorp key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
492 (append key nil)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
493 (mapcar (function (lambda (c)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
494 (if (> c 127)
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
495 (logxor c listify-key-sequence-1)
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
496 c)))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
497 (append key nil))))
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
498
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
499 (defsubst eventp (obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
500 "True if the argument is an event object."
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
501 (or (integerp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
502 (and (symbolp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
503 (get obj 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
504 (and (consp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
505 (symbolp (car obj))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
506 (get (car obj) 'event-symbol-elements))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
507
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
508 (defun event-modifiers (event)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
509 "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
510 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
511 `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
512 and `down'."
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
513 (let ((type event))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
514 (if (listp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
515 (setq type (car type)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
516 (if (symbolp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
517 (cdr (get type 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
518 (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
519 (or (zerop (logand type ?\M-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
520 (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
521 (or (and (zerop (logand type ?\C-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
522 (>= (logand type 127) 32))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
523 (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
524 (or (and (zerop (logand type ?\S-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
525 (= (logand type 255) (downcase (logand type 255))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
526 (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
527 (or (zerop (logand type ?\H-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
528 (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
529 (or (zerop (logand type ?\s-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
530 (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
531 (or (zerop (logand type ?\A-\^@))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
532 (setq list (cons 'alt list)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
533 list))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
534
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
535 (defun event-basic-type (event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
536 "Returns the basic type of the given event (all modifiers removed).
36468
80a057b7576b (event-basic-type): Doc fix.
Dave Love <fx@gnu.org>
parents: 36094
diff changeset
537 The value is a 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
538 (if (consp event)
d2df5ca46b39 * subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
539 (setq event (car event)))
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
540 (if (symbolp event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
541 (car (get event 'event-symbol-elements))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
542 (let ((base (logand event (1- (lsh 1 18)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
543 (downcase (if (< base 32) (logior base 64) base)))))
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
544
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
545 (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
546 "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
547 (and (consp object)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
548 (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
549
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
550 (defsubst event-start (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
551 "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
552 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
553 of the event.
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
554 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
555 The return value is of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
556 (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
557 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
558 (nth 1 event))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
559
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
560 (defsubst event-end (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
561 "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
562 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
563 The return value is of the form
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
564 (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
565 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
566 (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
567
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
568 (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
569 "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
570 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
571 (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
572
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
573 (defsubst posn-window (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
574 "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
575 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
576 (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
577 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
578 (nth 0 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
579
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
580 (defsubst posn-point (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
581 "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
582 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
583 (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
584 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
585 (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
586 (car (nth 1 position))
ad2bd545983e * subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents: 3927
diff changeset
587 (nth 1 position)))
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
588
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
589 (defsubst posn-x-y (position)
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
590 "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
591 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
592 (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
593 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
594 (nth 2 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
595
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
596 (defun posn-col-row (position)
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
597 "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
598 POSITION should be a list of the form
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
599 (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
600 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
601 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
602 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
603 (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
604 (window (posn-window position)))
7693
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
605 (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
606 (car (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
607 (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
608 'vertical-scroll-bar)
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
609 (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
610 (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
611 (car (nth 1 position))
5fcf0620b8d3 (posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents: 7640
diff changeset
612 (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
613 'horizontal-scroll-bar)
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
614 (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
615 (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
616 (x (/ (car pair) (frame-char-width frame)))
9b1194796ef5 (posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents: 7636
diff changeset
617 (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
618 (cons x y))))))
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
619
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
620 (defsubst posn-timestamp (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
621 "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
622 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
623 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
3411
d91b3097bb76 (posn-timestamp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3210
diff changeset
624 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
625 (nth 3 position))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
626
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
627
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
628 ;;;; Obsolescent names for functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
629
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
630 (defalias 'dot 'point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
631 (defalias 'dot-marker 'point-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
632 (defalias 'dot-min 'point-min)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
633 (defalias 'dot-max 'point-max)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
634 (defalias 'window-dot 'window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
635 (defalias 'set-window-dot 'set-window-point)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
636 (defalias 'read-input 'read-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
637 (defalias 'send-string 'process-send-string)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
638 (defalias 'send-region 'process-send-region)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
639 (defalias 'show-buffer 'set-window-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
640 (defalias 'buffer-flush-undo 'buffer-disable-undo)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
641 (defalias 'eval-current-buffer 'eval-buffer)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
642 (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
643 (defalias 'define-function 'defalias)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
644
23134
173e15236628 (sref): Make it an alias of aref. Make the
Kenichi Handa <handa@m17n.org>
parents: 23058
diff changeset
645 (defalias 'sref 'aref)
29354
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29062
diff changeset
646 (make-obsolete 'sref 'aref "20.4")
4ed4a700358b Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 29062
diff changeset
647 (make-obsolete 'char-bytes "Now this function always returns 1" "20.4")
20605
95e051979faf (sref): Defined.
Richard M. Stallman <rms@gnu.org>
parents: 20491
diff changeset
648
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
649 ;; 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
650 (defun baud-rate ()
3210
3176c6395ada (baud-rate): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 3153
diff changeset
651 "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
652 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
653 baud-rate)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
654
15599
7d3af2dcd864 (unfocus-frame, focus-frame): Define as no-ops.
Miles Bader <miles@gnu.org>
parents: 14707
diff changeset
655 (defalias 'focus-frame 'ignore)
7d3af2dcd864 (unfocus-frame, focus-frame): Define as no-ops.
Miles Bader <miles@gnu.org>
parents: 14707
diff changeset
656 (defalias 'unfocus-frame 'ignore)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
657
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
658 ;;;; 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
659
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
660 (defalias 'string= 'string-equal)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
661 (defalias 'string< 'string-lessp)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
662 (defalias 'move-marker 'set-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
663 (defalias 'not 'null)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
664 (defalias 'rplaca 'setcar)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
665 (defalias 'rplacd 'setcdr)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3411
diff changeset
666 (defalias 'beep 'ding) ;preserve lingual purity
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
667 (defalias 'indent-to-column 'indent-to)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
668 (defalias 'backward-delete-char 'delete-backward-char)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
669 (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
670 (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
671 (defalias 'int-to-string 'number-to-string)
21173
e917eb0d4e01 (save-match-data): store-match-data => set-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 21092
diff changeset
672 (defalias 'store-match-data 'set-match-data)
31563
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
673 ;; These are the XEmacs names:
25293
fd43e1a99384 (point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents: 25140
diff changeset
674 (defalias 'point-at-eol 'line-end-position)
fd43e1a99384 (point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents: 25140
diff changeset
675 (defalias 'point-at-bol 'line-beginning-position)
1903
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
676
87f63305319f * subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents: 1867
diff changeset
677 ;;; 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
678 ;;; 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
679 (defalias 'string-to-int 'string-to-number)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
680
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
681 ;;;; Hook manipulation functions.
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
682
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
683 (defun make-local-hook (hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
684 "Make the hook HOOK local to the current buffer.
23786
673204d56938 (make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents: 23736
diff changeset
685 The return value is HOOK.
673204d56938 (make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents: 23736
diff changeset
686
33707
2b9847c18f31 (make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32355
diff changeset
687 You never need to call this function now that `add-hook' does it for you
2b9847c18f31 (make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32355
diff changeset
688 if its LOCAL argument is non-nil.
2b9847c18f31 (make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 32355
diff changeset
689
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
690 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
691 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
692 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
693 of the hook variable.
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
694
12258
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
695 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
696 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
697 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
698 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
699 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
700 one.
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
701
95ebca0a74d8 (make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12108
diff changeset
702 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
703 buffer.
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
704
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
705 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
706 (if (local-variable-p hook)
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
707 nil
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
708 (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
709 (make-local-variable hook)
23786
673204d56938 (make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents: 23736
diff changeset
710 (set hook (list t)))
673204d56938 (make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents: 23736
diff changeset
711 hook)
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
712
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
713 (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
714 "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
715 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
716 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
717 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
718 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
719
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
720 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
721 the hook's buffer-local value rather than its default value.
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
722 This makes the hook buffer-local if needed.
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
723 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
724 `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
725
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
726 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
727 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
728 function, it is changed to a list of functions."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
729 (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
730 (or (default-boundp hook) (set-default hook nil))
33833
233f6f81744b (add-hook, remove-hook): Don't call make-local-hook
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33707
diff changeset
731 (if local (unless (local-variable-if-set-p hook) (make-local-hook hook))
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
732 ;; Detect the case where make-local-variable was used on a hook
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
733 ;; and do what we used to do.
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
734 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
735 (setq local t)))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
736 (let ((hook-value (if local (symbol-value hook) (default-value hook))))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
737 ;; If the hook value is a single function, turn it into a list.
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
738 (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
28940
2a91228f7aa3 (add-hook): setq hook-value, not set
Sam Steingold <sds@gnu.org>
parents: 28868
diff changeset
739 (setq hook-value (list hook-value)))
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
740 ;; Do the actual addition if necessary
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
741 (unless (member function hook-value)
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
742 (setq hook-value
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
743 (if append
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
744 (append hook-value (list function))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
745 (cons function hook-value))))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
746 ;; Set the actual variable
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
747 (if local (set hook hook-value) (set-default hook hook-value))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
748
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
749 (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
750 "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
751 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
752 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
753 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
754
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
755 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
756 the hook's buffer-local value rather than its default value.
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
757 This makes the hook buffer-local if needed.
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
758 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
759 `make-local-hook', not `make-local-variable'."
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
760 (or (boundp hook) (set hook nil))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
761 (or (default-boundp hook) (set-default hook nil))
33833
233f6f81744b (add-hook, remove-hook): Don't call make-local-hook
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33707
diff changeset
762 (if local (unless (local-variable-if-set-p hook) (make-local-hook hook))
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
763 ;; Detect the case where make-local-variable was used on a hook
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
764 ;; and do what we used to do.
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
765 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
766 (setq local t)))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
767 (let ((hook-value (if local (symbol-value hook) (default-value hook))))
29062
a11f776c0efc (remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28947
diff changeset
768 ;; Remove the function, for both the list and the non-list cases.
a11f776c0efc (remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28947
diff changeset
769 (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
a11f776c0efc (remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28947
diff changeset
770 (if (equal hook-value function) (setq hook-value nil))
a11f776c0efc (remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28947
diff changeset
771 (setq hook-value (delete function (copy-sequence hook-value))))
28863
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
772 ;; If the function is on the global hook, we need to shadow it locally
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
773 ;;(when (and local (member function (default-value hook))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
774 ;; (not (member (cons 'not function) hook-value)))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
775 ;; (push (cons 'not function) hook-value))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
776 ;; Set the actual variable
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
777 (if local (set hook hook-value) (set-default hook hook-value))))
9510
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
778
32355
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
779 (defun add-to-list (list-var element &optional append)
9535
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
780 "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
781 The test for presence of ELEMENT is done with `equal'.
32355
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
782 If ELEMENT is added, it is added at the beginning of the list,
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
783 unless the optional argument APPEND is non-nil, in which case
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
784 ELEMENT is added at the end.
24757
f4127409d184 (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 24699
diff changeset
785
9535
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
786 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
787 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
788 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
789 `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
790 other hooks, such as major mode hooks, can do the job."
21409
3e8b7782f4f5 (add-to-list): Always return updated value of LIST-VAR.
Karl Heuer <kwzh@gnu.org>
parents: 21173
diff changeset
791 (if (member element (symbol-value list-var))
3e8b7782f4f5 (add-to-list): Always return updated value of LIST-VAR.
Karl Heuer <kwzh@gnu.org>
parents: 21173
diff changeset
792 (symbol-value list-var)
32355
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
793 (set list-var
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
794 (if append
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
795 (append (symbol-value list-var) (list element))
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
796 (cons element (symbol-value list-var))))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
797
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
798 ;;;; 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
799
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
800 (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
801 "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
802 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
803 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
804 It does nothing if FORM is already on the list for FILE.
34750
90213af2c5ba (eval-after-load): Doc fix.
Dave Love <fx@gnu.org>
parents: 33997
diff changeset
805 FILE must match exactly. Normally FILE is the name of a library,
90213af2c5ba (eval-after-load): Doc fix.
Dave Love <fx@gnu.org>
parents: 33997
diff changeset
806 with no directory or extension specified, since that is how `load'
90213af2c5ba (eval-after-load): Doc fix.
Dave Love <fx@gnu.org>
parents: 33997
diff changeset
807 is normally called."
35231
c19a7d700b6d (eval-after-load): Call load-symbol-file-load-history to
Gerd Moellmann <gerd@gnu.org>
parents: 34898
diff changeset
808 ;; Make sure `load-history' contains the files dumped with Emacs
c19a7d700b6d (eval-after-load): Call load-symbol-file-load-history to
Gerd Moellmann <gerd@gnu.org>
parents: 34898
diff changeset
809 ;; for the case that FILE is one of the files dumped with Emacs.
c19a7d700b6d (eval-after-load): Call load-symbol-file-load-history to
Gerd Moellmann <gerd@gnu.org>
parents: 34898
diff changeset
810 (load-symbol-file-load-history)
10794
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
811 ;; 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
812 (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
813 (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
814 ;; 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
815 (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
816 (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
817 (progn
4443f78a2117 (eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents: 10693
diff changeset
818 (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
819 ;; 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
820 (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
821 (eval form)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
822 form)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
823
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
824 (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
825 "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
826 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
827 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
828 (eval-after-load file (read)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
829
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
830
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
831 ;;;; Input and display facilities.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
832
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
833 (defvar read-quoted-char-radix 8
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
834 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
835 Legitimate radix values are 8, 10 and 16.")
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
836
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
837 (custom-declare-variable-early
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
838 'read-quoted-char-radix 8
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
839 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
840 Legitimate radix values are 8, 10 and 16."
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
841 :type '(choice (const 8) (const 10) (const 16))
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
842 :group 'editing-basics)
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
843
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
844 (defun read-quoted-char (&optional prompt)
18821
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
845 "Like `read-char', but do not allow quitting.
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
846 Also, if the first character read is an octal digit,
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
847 we read any number of octal digits and return the
21008
7111f9cf9392 (read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 20939
diff changeset
848 specified character code. Any nondigit terminates the sequence.
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
849 If the terminator is RET, it is discarded;
18821
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
850 any other terminator is used itself as input.
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
851
21008
7111f9cf9392 (read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 20939
diff changeset
852 The optional argument PROMPT specifies a string to use to prompt the user.
7111f9cf9392 (read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 20939
diff changeset
853 The variable `read-quoted-char-radix' controls which radix to use
7111f9cf9392 (read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 20939
diff changeset
854 for numeric input."
18821
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
855 (let ((message-log-max nil) done (first t) (code 0) char)
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
856 (while (not done)
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
857 (let ((inhibit-quit first)
12108
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
858 ;; 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
859 (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
860 (help-form
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
861 "Type the special character you want to use,
18821
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
862 or the octal character code.
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
863 RET terminates the character code and is discarded;
18821
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
864 any other non-digit terminates the character code and is then used as input."))
23058
4d7992b69c29 (read-quoted-char): Don't bind input-method-function;
Richard M. Stallman <rms@gnu.org>
parents: 22960
diff changeset
865 (setq char (read-event (and prompt (format "%s-" prompt)) t))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
866 (if inhibit-quit (setq quit-flag nil)))
18948
faab6e4baa7d (read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents: 18880
diff changeset
867 ;; Translate TAB key into control-I ASCII character, and so on.
faab6e4baa7d (read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents: 18880
diff changeset
868 (and char
faab6e4baa7d (read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents: 18880
diff changeset
869 (let ((translated (lookup-key function-key-map (vector char))))
19175
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
870 (if (arrayp translated)
18948
faab6e4baa7d (read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents: 18880
diff changeset
871 (setq char (aref translated 0)))))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
872 (cond ((null char))
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
873 ((not (integerp char))
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
874 (setq unread-command-events (list char)
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
875 done t))
19175
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
876 ((/= (logand char ?\M-\^@) 0)
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
877 ;; Turn a meta-character into a character with the 0200 bit set.
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
878 (setq code (logior (logand char (lognot ?\M-\^@)) 128)
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
879 done t))
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
880 ((and (<= ?0 char) (< char (+ ?0 (min 10 read-quoted-char-radix))))
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
881 (setq code (+ (* code read-quoted-char-radix) (- char ?0)))
14343
ab021899d604 (read-quoted-char): Delete format call inside message.
Karl Heuer <kwzh@gnu.org>
parents: 14169
diff changeset
882 (and prompt (setq prompt (message "%s %c" prompt char))))
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
883 ((and (<= ?a (downcase char))
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
884 (< (downcase char) (+ ?a -10 (min 26 read-quoted-char-radix))))
19002
f21881dcd27b (read-quoted-char): Consistently downcase letter "digits".
Richard M. Stallman <rms@gnu.org>
parents: 18948
diff changeset
885 (setq code (+ (* code read-quoted-char-radix)
f21881dcd27b (read-quoted-char): Consistently downcase letter "digits".
Richard M. Stallman <rms@gnu.org>
parents: 18948
diff changeset
886 (+ 10 (- (downcase char) ?a))))
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
887 (and prompt (setq prompt (message "%s %c" prompt char))))
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
888 ((and (not first) (eq char ?\C-m))
18821
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
889 (setq done t))
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
890 ((not first)
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
891 (setq unread-command-events (list char)
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
892 done t))
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
893 (t (setq code char
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
894 done t)))
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
895 (setq first nil))
19175
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
896 code))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
897
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
898 (defun read-passwd (prompt &optional confirm default)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
899 "Read a password, prompting with PROMPT. Echo `.' for each character typed.
20472
79ea90039b23 (read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20410
diff changeset
900 End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
901 Optional argument CONFIRM, if non-nil, then read it twice to make sure.
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
902 Optional DEFAULT is a default password to use instead of empty input."
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
903 (if confirm
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
904 (let (success)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
905 (while (not success)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
906 (let ((first (read-passwd prompt nil default))
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
907 (second (read-passwd "Confirm password: " nil default)))
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
908 (if (equal first second)
36094
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
909 (progn
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
910 (and (arrayp second) (fillarray second ?\0))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
911 (setq success first))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
912 (and (arrayp first) (fillarray first ?\0))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
913 (and (arrayp second) (fillarray second ?\0))
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
914 (message "Password not repeated accurately; please start over")
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
915 (sit-for 1))))
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
916 success)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
917 (let ((pass nil)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
918 (c 0)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
919 (echo-keystrokes 0)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
920 (cursor-in-echo-area t))
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
921 (while (progn (message "%s%s"
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
922 prompt
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
923 (make-string (length pass) ?.))
28628
60285ddb5d02 (read-passwd): Use read-char-exclusive.
Richard M. Stallman <rms@gnu.org>
parents: 28490
diff changeset
924 (setq c (read-char-exclusive nil t))
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
925 (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
37028
f023c8a482ec (read-passwd): Clear command history after each
Gerd Moellmann <gerd@gnu.org>
parents: 36468
diff changeset
926 (clear-this-command-keys)
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
927 (if (= c ?\C-u)
36094
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
928 (progn
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
929 (and (arrayp pass) (fillarray pass ?\0))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
930 (setq pass ""))
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
931 (if (and (/= c ?\b) (/= c ?\177))
36094
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
932 (let* ((new-char (char-to-string c))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
933 (new-pass (concat pass new-char)))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
934 (and (arrayp pass) (fillarray pass ?\0))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
935 (fillarray new-char ?\0)
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
936 (setq c ?\0)
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
937 (setq pass new-pass))
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
938 (if (> (length pass) 0)
36094
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
939 (let ((new-pass (substring pass 0 -1)))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
940 (and (arrayp pass) (fillarray pass ?\0))
fddc05f3f926 (read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents: 35281
diff changeset
941 (setq pass new-pass))))))
21092
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
942 (message nil)
7726f8d9eff0 (read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents: 21066
diff changeset
943 (or pass default ""))))
20472
79ea90039b23 (read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20410
diff changeset
944
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
945 (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
946 "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
947 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
948 (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
949 (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
950
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
951 (defun momentary-string-display (string pos &optional exit-char message)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
952 "Momentarily display STRING in the buffer at POS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
953 Display remains until next character is typed.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
954 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
955 otherwise it is then available as input (as a command if nothing else).
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
956 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
957 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
958 (or exit-char (setq exit-char ?\ ))
24322
ca77d79a0c21 (momentary-string-display): Bind inhibit-read-only.
Richard M. Stallman <rms@gnu.org>
parents: 24245
diff changeset
959 (let ((inhibit-read-only t)
6553
fca6271b0983 (momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents: 6551
diff changeset
960 ;; 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
961 (buffer-undo-list t)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
962 (modified (buffer-modified-p))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
963 (name buffer-file-name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
964 insert-end)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
965 (unwind-protect
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
966 (progn
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
967 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
968 (goto-char pos)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
969 ;; defeat file locking... don't try this at home, kids!
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
970 (setq buffer-file-name nil)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
971 (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
972 (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
973 ;; If the message end is off screen, recenter now.
21173
e917eb0d4e01 (save-match-data): store-match-data => set-match-data.
Richard M. Stallman <rms@gnu.org>
parents: 21092
diff changeset
974 (if (< (window-end nil t) insert-end)
4620
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
975 (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
976 ;; 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
977 ;; 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
978 (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
979 (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
980 (progn
5474175de175 (momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents: 4518
diff changeset
981 (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
982 (recenter 0))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
983 (message (or message "Type %s to continue editing.")
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
984 (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
985 (let ((char (read-event)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
986 (or (eq char exit-char)
1821
04fb1d3d6992 JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents: 1695
diff changeset
987 (setq unread-command-events (list char)))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
988 (if insert-end
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
989 (save-excursion
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
990 (delete-region pos insert-end)))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
991 (setq buffer-file-name name)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
992 (set-buffer-modified-p modified))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
993
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
994
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
995 ;;;; Miscellanea.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
996
10254
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
997 ;; A number of major modes set this locally.
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
998 ;; 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
999 (defvar font-lock-defaults nil)
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
1000
20846
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
1001 (defvar suspend-hook nil
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
1002 "Normal hook run by `suspend-emacs', before suspending.")
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
1003
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
1004 (defvar suspend-resume-hook nil
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
1005 "Normal hook run by `suspend-emacs', after Emacs is continued.")
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
1006
10254
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
1007 ;; Avoid compiler warnings about this variable,
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
1008 ;; 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
1009 (defvar buffer-file-type nil
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
1010 "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
1011 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
1012 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
1013 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
1014
14515
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
1015 ;; 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
1016 (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
1017 "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
1018 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
1019 (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
1020 (walk-windows (function (lambda (window)
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
1021 (if (eq (window-buffer window) buffer)
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
1022 (setq windows (cons window windows)))))
14707
ddcae263bb18 Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents: 14517
diff changeset
1023 minibuf frame)
14515
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
1024 windows))
b35134a0e47a Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents: 14343
diff changeset
1025
8211
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
1026 (defun ignore (&rest ignore)
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
1027 "Do nothing and return nil.
08fb5e917205 (ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents: 7693
diff changeset
1028 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
1029 (interactive)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1030 nil)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1031
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1032 (defun error (&rest args)
13936
24ff5e49ac27 (error): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 13812
diff changeset
1033 "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
1034 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
1035 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
1036 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
1037 (while t
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1038 (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
1039
5912
909b94d547c4 (user-original-login-name): Reduce to a defalias, since it's redundant with
Karl Heuer <kwzh@gnu.org>
parents: 5844
diff changeset
1040 (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
1041
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1042 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1043 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1044 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1045 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
1046 BUFFER is the buffer or (buffer-name) to associate with the process.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1047 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1048 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1049 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1050 with any buffer
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1051 Third arg is command name, the name of a shell command.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1052 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
1053 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
1054 (cond
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
1055 ((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
1056 (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
1057 ;; 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
1058 ;; 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
1059 (t
248462096d25 (start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents: 9535
diff changeset
1060 (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
1061 (mapconcat 'identity args " ")))))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
1062
16277
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
1063 (defmacro with-current-buffer (buffer &rest body)
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
1064 "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
1065 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
1066 See also `with-temp-buffer'."
26002
4f46db3c9d7d * subr.el (with-current-buffer): don't use backquotes to avoid
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25706
diff changeset
1067 (cons 'save-current-buffer
4f46db3c9d7d * subr.el (with-current-buffer): don't use backquotes to avoid
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25706
diff changeset
1068 (cons (list 'set-buffer buffer)
4f46db3c9d7d * subr.el (with-current-buffer): don't use backquotes to avoid
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 25706
diff changeset
1069 body)))
16277
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
1070
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1071 (defmacro with-temp-file (file &rest body)
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1072 "Create a new buffer, evaluate BODY there, and write the buffer to FILE.
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1073 The value returned is the value of the last form in BODY.
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1074 See also `with-temp-buffer'."
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
1075 (let ((temp-file (make-symbol "temp-file"))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1076 (temp-buffer (make-symbol "temp-buffer")))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1077 `(let ((,temp-file ,file)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1078 (,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1079 (get-buffer-create (generate-new-buffer-name " *temp file*"))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1080 (unwind-protect
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1081 (prog1
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1082 (with-current-buffer ,temp-buffer
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1083 ,@body)
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1084 (with-current-buffer ,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1085 (widen)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1086 (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
1087 (and (buffer-name ,temp-buffer)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1088 (kill-buffer ,temp-buffer))))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1089
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1090 (defmacro with-temp-message (message &rest body)
24011
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
1091 "Display MESSAGE temporarily if non-nil while BODY is evaluated.
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1092 The original message is restored to the echo area after BODY has finished.
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1093 The value returned is the value of the last form in BODY.
24011
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
1094 MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
1095 If MESSAGE is nil, the echo area and message log buffer are unchanged.
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
1096 Use a MESSAGE of \"\" to temporarily clear the echo area."
24000
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
1097 (let ((current-message (make-symbol "current-message"))
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
1098 (temp-message (make-symbol "with-temp-message")))
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
1099 `(let ((,temp-message ,message)
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
1100 (,current-message))
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1101 (unwind-protect
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1102 (progn
24000
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
1103 (when ,temp-message
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
1104 (setq ,current-message (current-message))
24699
1ce8c890309e (with-temp-message): Fix the other call to message to use %s.
Karl Heuer <kwzh@gnu.org>
parents: 24385
diff changeset
1105 (message "%s" ,temp-message))
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1106 ,@body)
24385
92817fedff02 (with-temp-message): Use %s so % in old msg won't fool us.
Karl Heuer <kwzh@gnu.org>
parents: 24322
diff changeset
1107 (and ,temp-message ,current-message
92817fedff02 (with-temp-message): Use %s so % in old msg won't fool us.
Karl Heuer <kwzh@gnu.org>
parents: 24322
diff changeset
1108 (message "%s" ,current-message))))))
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1109
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1110 (defmacro with-temp-buffer (&rest body)
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1111 "Create a temporary buffer, and evaluate BODY there like `progn'.
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1112 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
1113 (let ((temp-buffer (make-symbol "temp-buffer")))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1114 `(let ((,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1115 (get-buffer-create (generate-new-buffer-name " *temp*"))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1116 (unwind-protect
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1117 (with-current-buffer ,temp-buffer
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
1118 ,@body)
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1119 (and (buffer-name ,temp-buffer)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1120 (kill-buffer ,temp-buffer))))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1121
16311
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
1122 (defmacro with-output-to-string (&rest body)
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
1123 "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
1124 `(let ((standard-output
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1125 (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
1126 (let ((standard-output standard-output))
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
1127 ,@body)
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1128 (with-current-buffer standard-output
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1129 (prog1
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1130 (buffer-string)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1131 (kill-buffer nil)))))
16549
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1132
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1133 (defmacro combine-after-change-calls (&rest body)
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1134 "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
1135 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
1136 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
1137 when BODY is finished.
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1138 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
1139
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1140 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
1141 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
1142
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1143 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
1144 in BODY."
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1145 `(unwind-protect
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1146 (let ((combine-after-change-calls t))
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1147 . ,body)
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1148 (combine-after-change-execute)))
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
1149
28234
763c6639628b (combine-run-hooks): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28148
diff changeset
1150
27297
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1151 (defmacro with-syntax-table (table &rest body)
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1152 "Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1153 The syntax table of the current buffer is saved, BODY is evaluated, and the
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1154 saved table is restored, even in case of an abnormal exit.
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1155 Value is what BODY returns."
27384
a10a13dd0670 (with-syntax-table): Use make-symbol, not gensym.
Richard M. Stallman <rms@gnu.org>
parents: 27383
diff changeset
1156 (let ((old-table (make-symbol "table"))
a10a13dd0670 (with-syntax-table): Use make-symbol, not gensym.
Richard M. Stallman <rms@gnu.org>
parents: 27383
diff changeset
1157 (old-buffer (make-symbol "buffer")))
27297
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1158 `(let ((,old-table (syntax-table))
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1159 (,old-buffer (current-buffer)))
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1160 (unwind-protect
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1161 (progn
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1162 (set-syntax-table (copy-syntax-table ,table))
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1163 ,@body)
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1164 (save-current-buffer
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1165 (set-buffer ,old-buffer)
f5713c397636 (with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents: 26084
diff changeset
1166 (set-syntax-table ,old-table))))))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
1167
15955
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
1168 (defvar save-match-data-internal)
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
1169
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
1170 ;; 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
1171 ;; 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
1172 ;; 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
1173 ;; 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
1174 (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
1175 "Execute the BODY forms, restoring the global value of the match data."
26084
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1176 ;; It is better not to use backquote here,
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1177 ;; because that makes a bootstrapping problem
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1178 ;; if you need to recompile all the Lisp files using interpreted code.
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1179 (list 'let
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1180 '((save-match-data-internal (match-data)))
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1181 (list 'unwind-protect
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1182 (cons 'progn body)
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
1183 '(set-match-data save-match-data-internal))))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
1184
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
1185 (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
1186 "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
1187 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
1188 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
1189 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
1190 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
1191 (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
1192 (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
1193 (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
1194 (buffer-substring (match-beginning num) (match-end num)))))
10560
fd09d51dfd77 (match-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10368
diff changeset
1195
20491
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1196 (defun match-string-no-properties (num &optional string)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1197 "Return string of text matched by last search, without text properties.
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1198 NUM specifies which parenthesized expression in the last regexp.
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1199 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1200 Zero means the entire text matched by the whole regexp or whole string.
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1201 STRING should be given if the last search was by `string-match' on STRING."
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1202 (if (match-beginning num)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1203 (if string
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1204 (let ((result
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1205 (substring string (match-beginning num) (match-end num))))
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1206 (set-text-properties 0 (length result) nil result)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1207 result)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1208 (buffer-substring-no-properties (match-beginning num)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1209 (match-end num)))))
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
1210
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1211 (defun split-string (string &optional separators)
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1212 "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
1213 Each match for SEPARATORS is a splitting point.
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1214 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
1215 which is returned.
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1216 If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\".
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1217
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1218 If there is match for SEPARATORS at the beginning of STRING, we do not
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1219 include a null substring for that. Likewise, if there is a match
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1220 at the end of STRING, we don't include a null substring for that.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1221
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1222 Modifies the match data; use `save-match-data' if necessary."
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1223 (let ((rexp (or separators "[ \f\t\n\r\v]+"))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1224 (start 0)
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1225 notfirst
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1226 (list nil))
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1227 (while (and (string-match rexp string
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1228 (if (and notfirst
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1229 (= start (match-beginning 0))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1230 (< start (length string)))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1231 (1+ start) start))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1232 (< (match-beginning 0) (length string)))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1233 (setq notfirst t)
16333
585956e62c87 (split-string): Fix minor bug.
Richard M. Stallman <rms@gnu.org>
parents: 16314
diff changeset
1234 (or (eq (match-beginning 0) 0)
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1235 (and (eq (match-beginning 0) (match-end 0))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
1236 (eq (match-beginning 0) start))
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1237 (setq list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1238 (cons (substring string start (match-beginning 0))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1239 list)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1240 (setq start (match-end 0)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1241 (or (eq start (length string))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1242 (setq list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1243 (cons (substring string start)
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1244 list)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
1245 (nreverse list)))
24089
70954a8be49b (subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents: 24011
diff changeset
1246
70954a8be49b (subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents: 24011
diff changeset
1247 (defun subst-char-in-string (fromchar tochar string &optional inplace)
70954a8be49b (subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents: 24011
diff changeset
1248 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
70954a8be49b (subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents: 24011
diff changeset
1249 Unless optional argument INPLACE is non-nil, return a new string."
33835
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1250 (let ((i (length string))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1251 (newstr (if inplace string (copy-sequence string))))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1252 (while (> i 0)
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1253 (setq i (1- i))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1254 (if (eq (aref newstr i) fromchar)
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1255 (aset newstr i tochar)))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
1256 newstr))
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1257
28148
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1258 (defun replace-regexp-in-string (regexp rep string &optional
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1259 fixedcase literal subexp start)
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1260 "Replace all matches for REGEXP with REP in STRING.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1261
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1262 Return a new string containing the replacements.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1263
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1264 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1265 arguments with the same names of function `replace-match'. If START
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1266 is non-nil, start replacements at that index in STRING.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1267
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1268 REP is either a string used as the NEWTEXT arg of `replace-match' or a
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1269 function. If it is a function it is applied to each match to generate
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1270 the replacement passed to `replace-match'; the match-data at this
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1271 point are such that match 0 is the function's argument.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1272
28148
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1273 To replace only the first match (if any), make REGEXP match up to \\'
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1274 and replace a sub-expression, e.g.
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1275 (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1)
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1276 => \" bar foo\"
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
1277 "
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1278
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1279 ;; To avoid excessive consing from multiple matches in long strings,
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1280 ;; don't just call `replace-match' continually. Walk down the
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1281 ;; string looking for matches of REGEXP and building up a (reversed)
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1282 ;; list MATCHES. This comprises segments of STRING which weren't
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1283 ;; matched interspersed with replacements for segments that were.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1284 ;; [For a `large' number of replacments it's more efficient to
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1285 ;; operate in a temporary buffer; we can't tell from the function's
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1286 ;; args whether to choose the buffer-based implementation, though it
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1287 ;; might be reasonable to do so for long enough STRING.]
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1288 (let ((l (length string))
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1289 (start (or start 0))
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1290 matches str mb me)
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1291 (save-match-data
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1292 (while (and (< start l) (string-match regexp string start))
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1293 (setq mb (match-beginning 0)
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1294 me (match-end 0))
28065
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1295 ;; If we matched the empty string, make sure we advance by one char
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1296 (when (= me mb) (setq me (min l (1+ mb))))
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1297 ;; Generate a replacement for the matched substring.
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1298 ;; Operate only on the substring to minimize string consing.
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1299 ;; Set up match data for the substring for replacement;
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1300 ;; presumably this is likely to be faster than munging the
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1301 ;; match data directly in Lisp.
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1302 (string-match regexp (setq str (substring string mb me)))
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1303 (setq matches
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1304 (cons (replace-match (if (stringp rep)
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1305 rep
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1306 (funcall rep (match-string 0 str)))
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1307 fixedcase literal str subexp)
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1308 (cons (substring string start mb) ; unmatched prefix
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1309 matches)))
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
1310 (setq start me))
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1311 ;; Reconstruct a string from the pieces.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1312 (setq matches (cons (substring string start l) matches)) ; leftover
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
1313 (apply #'concat (nreverse matches)))))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
1314
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
1315 (defun shell-quote-argument (argument)
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
1316 "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
1317 (if (eq system-type 'ms-dos)
25706
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1318 ;; Quote using double quotes, but escape any existing quotes in
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1319 ;; the argument with backslashes.
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1320 (let ((result "")
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1321 (start 0)
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1322 end)
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1323 (if (or (null (string-match "[^\"]" argument))
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1324 (< (match-end 0) (length argument)))
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1325 (while (string-match "[\"]" argument start)
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1326 (setq end (match-beginning 0)
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1327 result (concat result (substring argument start end)
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1328 "\\" (substring argument end (1+ end)))
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1329 start (1+ end))))
498eb90e1723 (shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents: 25631
diff changeset
1330 (concat "\"" result (substring argument start) "\""))
12465
0d404ef125ea (shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents: 12395
diff changeset
1331 (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
1332 (concat "\"" argument "\"")
17610
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1333 (if (equal argument "")
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1334 "''"
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1335 ;; Quote everything except POSIX filename characters.
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1336 ;; 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
1337 (let ((result "") (start 0) end)
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1338 (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
1339 (setq end (match-beginning 0)
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1340 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
1341 "\\" (substring argument end (1+ end)))
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1342 start (1+ end)))
f95fbf6f1234 (shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents: 17437
diff changeset
1343 (concat result (substring argument start)))))))
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
1344
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
1345 (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
1346 "Return a new syntax table.
17612
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
1347 If OLDTABLE is non-nil, copy OLDTABLE.
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
1348 Otherwise, create a syntax table which inherits
beaac591604a (make-syntax-table): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 17610
diff changeset
1349 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
1350 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
1351 (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
1352 (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
1353 (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
1354 i)
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
1355 (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
1356 (while (<= i 31)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
1357 (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
1358 (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
1359 (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
1360 (while (<= i ?Z)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
1361 (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
1362 (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
1363 (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
1364 (while (<= i ?z)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
1365 (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
1366 (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
1367 (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
1368 (while (<= i 255)
13186
6d3d7b32c519 (make-syntax-table): Use nil for "inherit".
Richard M. Stallman <rms@gnu.org>
parents: 13039
diff changeset
1369 (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
1370 (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
1371 table)))
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1372
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1373 (defun add-to-invisibility-spec (arg)
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1374 "Add elements to `buffer-invisibility-spec'.
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1375 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
1376 that can be added."
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1377 (cond
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1378 ((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
1379 (setq buffer-invisibility-spec (list arg)))
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1380 (t
17158
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
1381 (setq buffer-invisibility-spec
f181580c182c (when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents: 17152
diff changeset
1382 (cons arg buffer-invisibility-spec)))))
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1383
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1384 (defun remove-from-invisibility-spec (arg)
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
1385 "Remove elements from `buffer-invisibility-spec'."
24245
418feab1639c *** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents: 24089
diff changeset
1386 (if (consp buffer-invisibility-spec)
17152
3c55ec545afb Fix typo in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 17146
diff changeset
1387 (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
1388
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1389 (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
1390 "Give KEY a global binding as COMMAND.
20410
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1391 COMMAND is the command definition to use; usually it is
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1392 a symbol naming an interactively-callable function.
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1393 KEY is a key sequence; noninteractively, it is a string or vector
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1394 of characters or event types, and non-ASCII characters with codes
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1395 above 127 (such as ISO Latin-1) can be included if you use a vector.
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1396
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1397 Note that if KEY has a local binding in the current buffer,
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1398 that local binding will continue to shadow any global binding
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1399 that you make with this function."
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1400 (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
1401 (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
1402 (signal 'wrong-type-argument (list 'arrayp key)))
21578
6175866e1b71 (local-set-key, global-set-key): Return what define-key returns.
Richard M. Stallman <rms@gnu.org>
parents: 21409
diff changeset
1403 (define-key (current-global-map) key command))
5421
a248a39fa4b8 (make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents: 5385
diff changeset
1404
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1405 (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
1406 "Give KEY a local binding as COMMAND.
20410
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1407 COMMAND is the command definition to use; usually it is
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1408 a symbol naming an interactively-callable function.
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1409 KEY is a key sequence; noninteractively, it is a string or vector
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1410 of characters or event types, and non-ASCII characters with codes
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1411 above 127 (such as ISO Latin-1) can be included if you use a vector.
af925352116e (global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 19662
diff changeset
1412
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1413 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
1414 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
1415 (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
1416 (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
1417 (or map
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1418 (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
1419 (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
1420 (signal 'wrong-type-argument (list 'arrayp key)))
21578
6175866e1b71 (local-set-key, global-set-key): Return what define-key returns.
Richard M. Stallman <rms@gnu.org>
parents: 21409
diff changeset
1421 (define-key map key command)))
10825
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1422
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1423 (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
1424 "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
1425 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
1426 (interactive "kUnset key globally: ")
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1427 (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
1428
10826
bd0ab0601489 (local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 10825
diff changeset
1429 (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
1430 "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
1431 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
1432 (interactive "kUnset key locally: ")
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1433 (if (current-local-map)
10826
bd0ab0601489 (local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents: 10825
diff changeset
1434 (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
1435 nil)
4dba26c66bf5 (global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents: 10794
diff changeset
1436
12016
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1437 ;; 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
1438 ;; 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
1439 (defun frame-configuration-p (object)
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1440 "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
1441 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
1442 configuration."
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1443 (and (consp object)
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1444 (eq (car object) 'frame-configuration)))
3fd7ef954be6 (frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents: 11640
diff changeset
1445
17418
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1446 (defun functionp (object)
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
1447 "Non-nil if OBJECT is a type of object that can be called as a function."
19176
d8eb24685152 (functionp): Use byte-code-function-p, not compiled-function-p.
Richard M. Stallman <rms@gnu.org>
parents: 19175
diff changeset
1448 (or (subrp object) (byte-code-function-p object)
17418
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1449 (eq (car-safe object) 'lambda)
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1450 (and (symbolp object) (fboundp object))))
726a87ac1486 (functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents: 17215
diff changeset
1451
37054
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1452 (defun interactive-form (function)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1453 "Return the interactive form of FUNCTION.
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1454 If function is a command (see `commandp'), value is a list of the form
37055
4cb750b910d1 Fix typo.
Gerd Moellmann <gerd@gnu.org>
parents: 37054
diff changeset
1455 \(interactive SPEC). If function is not a command, return nil."
37054
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1456 (setq function (indirect-function function))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1457 (when (commandp function)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1458 (cond ((byte-code-function-p function)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1459 (when (> (length function) 5)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1460 (let ((spec (aref function 5)))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1461 (if spec
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1462 (list 'interactive spec)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1463 (list 'interactive)))))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1464 ((subrp function)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1465 (subr-interactive-form function))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1466 ((eq (car-safe function) 'lambda)
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1467 (setq function (cddr function))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1468 (when (stringp (car function))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1469 (setq function (cdr function)))
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1470 (let ((form (car function)))
37070
838adca2d2fd (interactive-form): Fix paren typo.
Miles Bader <miles@gnu.org>
parents: 37055
diff changeset
1471 (when (eq (car-safe form) 'interactive)
37054
dec182bcbaa4 (interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 37028
diff changeset
1472 (copy-sequence form)))))))
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
1473
27908
1c1e1ebca7f8 (assq-delete-all): Renamed from assoc-delete-all.
Gerd Moellmann <gerd@gnu.org>
parents: 27821
diff changeset
1474 (defun assq-delete-all (key alist)
25140
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1475 "Delete from ALIST all elements whose car is KEY.
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1476 Return the modified alist."
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1477 (let ((tail alist))
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1478 (while tail
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1479 (if (eq (car (car tail)) key)
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1480 (setq alist (delq (car tail) alist)))
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1481 (setq tail (cdr tail)))
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1482 alist))
e4493f0697ae (assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents: 24757
diff changeset
1483
25631
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1484 (defun make-temp-file (prefix &optional dir-flag)
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1485 "Create a temporary file.
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1486 The returned file name (created by appending some random characters at the end
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1487 of PREFIX, and expanding against `temporary-file-directory' if necessary,
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1488 is guaranteed to point to a newly created empty file.
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1489 You can then use `write-region' to write new data into the file.
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1490
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1491 If DIR-FLAG is non-nil, create a new empty directory instead of a file."
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1492 (let (file)
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1493 (while (condition-case ()
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1494 (progn
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1495 (setq file
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1496 (make-temp-name
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1497 (expand-file-name prefix temporary-file-directory)))
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1498 (if dir-flag
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1499 (make-directory file)
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1500 (write-region "" nil file nil 'silent nil 'excl))
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1501 nil)
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1502 (file-already-exists t))
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1503 ;; the file was somehow created by someone else between
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1504 ;; `make-temp-name' and `write-region', let's try again.
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1505 nil)
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1506 file))
0987f52a0674 (make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents: 25580
diff changeset
1507
28720
f8379b011476 (add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28628
diff changeset
1508
28751
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1509 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
28720
f8379b011476 (add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28628
diff changeset
1510 "Register a new minor mode.
28751
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1511
31979
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1512 This is an XEmacs-compatibility function. Use `define-minor-mode' instead.
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1513
28751
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1514 TOGGLE is a symbol which is the name of a buffer-local variable that
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1515 is toggled on or off to say whether the minor mode is active or not.
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1516
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1517 NAME specifies what will appear in the mode line when the minor mode
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1518 is active. NAME should be either a string starting with a space, or a
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1519 symbol whose value is such a string.
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1520
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1521 Optional KEYMAP is the keymap for the minor mode that will be added
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1522 to `minor-mode-map-alist'.
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1523
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1524 Optional AFTER specifies that TOGGLE should be added after AFTER
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1525 in `minor-mode-alist'.
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1526
31979
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1527 Optional TOGGLE-FUN is an interactive function to toggle the mode.
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1528 It defaults to (and should by convention be) TOGGLE.
31563
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1529
31979
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1530 If TOGGLE has a non-nil `:included' property, an entry for the mode is
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1531 included in the mode-line minor mode menu.
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1532 If TOGGLE has a `:menu-tag', that is used for the menu item's label."
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1533 (unless toggle-fun (setq toggle-fun toggle))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1534 ;; Add the toggle to the minor-modes menu if requested.
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1535 (when (get toggle :included)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1536 (define-key mode-line-mode-menu
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1537 (vector toggle)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1538 (list 'menu-item
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1539 (or (get toggle :menu-tag)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1540 (if (stringp name) name (symbol-name toggle)))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1541 toggle-fun
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1542 :button (cons :toggle toggle))))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1543 ;; Add the name to the minor-mode-alist.
28751
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1544 (when name
31979
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1545 (let ((existing (assq toggle minor-mode-alist)))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1546 (when (and (stringp name) (not (get-text-property 0 'local-map name)))
31563
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1547 (setq name
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1548 (apply 'propertize name
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1549 'local-map (make-mode-line-mouse2-map toggle-fun)
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1550 (unless (get-text-property 0 'help-echo name)
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1551 (list 'help-echo
31979
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1552 (format "mouse-2: turn off %S" toggle))))))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1553 (if existing
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1554 (setcdr existing (list name))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1555 (let ((tail minor-mode-alist) found)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1556 (while (and tail (not found))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1557 (if (eq after (caar tail))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1558 (setq found tail)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1559 (setq tail (cdr tail))))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1560 (if found
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1561 (let ((rest (cdr found)))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1562 (setcdr found nil)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1563 (nconc found (list (list toggle name)) rest))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1564 (setq minor-mode-alist (cons (list toggle name)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1565 minor-mode-alist)))))))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1566 ;; Add the map to the minor-mode-map-alist.
28751
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1567 (when keymap
6a79bbe8bf72 *** empty log message ***
Gerd Moellmann <gerd@gnu.org>
parents: 28730
diff changeset
1568 (let ((existing (assq toggle minor-mode-map-alist)))
31979
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1569 (if existing
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1570 (setcdr existing keymap)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1571 (let ((tail minor-mode-map-alist) found)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1572 (while (and tail (not found))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1573 (if (eq after (caar tail))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1574 (setq found tail)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1575 (setq tail (cdr tail))))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1576 (if found
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1577 (let ((rest (cdr found)))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1578 (setcdr found nil)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1579 (nconc found (list (cons toggle keymap)) rest))
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1580 (setq minor-mode-map-alist (cons (cons toggle keymap)
6085a3297ebc (add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 31563
diff changeset
1581 minor-mode-map-alist))))))))
28720
f8379b011476 (add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28628
diff changeset
1582
32131
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1583 ;; XEmacs compatibility/convenience.
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1584 (if (fboundp 'play-sound)
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1585 (defun play-sound-file (file &optional volume device)
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1586 "Play sound stored in FILE.
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1587 VOLUME and DEVICE correspond to the keywords of the sound
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1588 specification for `play-sound'."
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1589 (interactive "fPlay sound file: ")
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1590 (let ((sound (list :file file)))
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1591 (if volume
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1592 (plist-put sound :volume volume))
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1593 (if device
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1594 (plist-put sound :device device))
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1595 (push 'sound sound)
3a54b3a6bf40 (substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents: 31979
diff changeset
1596 (play-sound sound))))
28720
f8379b011476 (add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents: 28628
diff changeset
1597
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
1598 ;;; subr.el ends here