658
|
1 ;;; subr.el --- basic lisp subroutines for Emacs
|
787
|
2
|
57151
|
3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003,
|
75347
|
4 ;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
|
114
|
5
|
45078
|
6 ;; Maintainer: FSF
|
|
7 ;; Keywords: internal
|
|
8
|
114
|
9 ;; This file is part of GNU Emacs.
|
|
10
|
|
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
|
|
12 ;; it under the terms of the GNU General Public License as published by
|
707
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
114
|
14 ;; any later version.
|
|
15
|
|
16 ;; GNU Emacs is distributed in the hope that it will be useful,
|
|
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
19 ;; GNU General Public License for more details.
|
|
20
|
|
21 ;; You should have received a copy of the GNU General Public License
|
14169
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64091
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
114
|
25
|
38414
|
26 ;;; Commentary:
|
|
27
|
787
|
28 ;;; Code:
|
18880
|
29 (defvar custom-declare-variable-list nil
|
|
30 "Record `defcustom' calls made before `custom.el' is loaded to handle them.
|
|
31 Each element of this list holds the arguments to one call to `defcustom'.")
|
114
|
32
|
19662
|
33 ;; Use this, rather than defcustom, in subr.el and other files loaded
|
18880
|
34 ;; before custom.el.
|
|
35 (defun custom-declare-variable-early (&rest arguments)
|
|
36 (setq custom-declare-variable-list
|
|
37 (cons arguments custom-declare-variable-list)))
|
44129
|
38
|
|
39
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
40 ;;;; Basic Lisp macros.
|
2504
|
41
|
40822
|
42 (defalias 'not 'null)
|
|
43
|
53197
|
44 (defmacro noreturn (form)
|
67899
|
45 "Evaluate FORM, expecting it not to return.
|
|
46 If FORM does return, signal an error."
|
53197
|
47 `(prog1 ,form
|
|
48 (error "Form marked with `noreturn' did return")))
|
|
49
|
|
50 (defmacro 1value (form)
|
67899
|
51 "Evaluate FORM, expecting a constant return value.
|
|
52 This is the global do-nothing version. There is also `testcover-1value'
|
|
53 that complains if FORM ever does return differing values."
|
53197
|
54 form)
|
|
55
|
71726
|
56 (defmacro def-edebug-spec (symbol spec)
|
|
57 "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
|
|
58 Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
|
|
59 \(naming a function), or a list."
|
|
60 `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
|
|
61
|
2504
|
62 (defmacro lambda (&rest cdr)
|
|
63 "Return a lambda expression.
|
|
64 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
|
|
65 self-quoting; the result of evaluating the lambda expression is the
|
|
66 expression itself. The lambda expression may then be treated as a
|
10178
|
67 function, i.e., stored as the function value of a symbol, passed to
|
63634
|
68 `funcall' or `mapcar', etc.
|
10178
|
69
|
2504
|
70 ARGS should take the same form as an argument list for a `defun'.
|
12395
|
71 DOCSTRING is an optional documentation string.
|
|
72 If present, it should describe how to call the function.
|
|
73 But documentation strings are usually not useful in nameless functions.
|
2504
|
74 INTERACTIVE should be a call to the function `interactive', which see.
|
|
75 It may also be omitted.
|
55406
|
76 BODY should be a list of Lisp expressions.
|
|
77
|
|
78 \(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)"
|
2504
|
79 ;; Note that this definition should not use backquotes; subr.el should not
|
|
80 ;; depend on backquote.el.
|
|
81 (list 'function (cons 'lambda cdr)))
|
|
82
|
25437
|
83 (defmacro push (newelt listname)
|
25580
|
84 "Add NEWELT to the list stored in the symbol LISTNAME.
|
25437
|
85 This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)).
|
25436
|
86 LISTNAME must be a symbol."
|
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
87 (declare (debug (form sexp)))
|
25469
|
88 (list 'setq listname
|
|
89 (list 'cons newelt listname)))
|
25436
|
90
|
|
91 (defmacro pop (listname)
|
|
92 "Return the first element of LISTNAME's value, and remove it from the list.
|
|
93 LISTNAME must be a symbol whose value is a list.
|
|
94 If the value is nil, `pop' returns nil but does not actually
|
|
95 change the list."
|
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
96 (declare (debug (sexp)))
|
45823
|
97 (list 'car
|
|
98 (list 'prog1 listname
|
|
99 (list 'setq listname (list 'cdr listname)))))
|
25436
|
100
|
16845
|
101 (defmacro when (cond &rest body)
|
27810
|
102 "If COND yields non-nil, do BODY, else return nil."
|
51051
|
103 (declare (indent 1) (debug t))
|
16845
|
104 (list 'if cond (cons 'progn body)))
|
2504
|
105
|
16845
|
106 (defmacro unless (cond &rest body)
|
27810
|
107 "If COND yields nil, do BODY, else return nil."
|
51051
|
108 (declare (indent 1) (debug t))
|
16845
|
109 (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>
diff
changeset
|
110
|
72096
|
111 (defvar --dolist-tail-- nil
|
|
112 "Temporary variable used in `dolist' expansion.")
|
|
113
|
27376
|
114 (defmacro dolist (spec &rest body)
|
51051
|
115 "Loop over a list.
|
27376
|
116 Evaluate BODY with VAR bound to each car from LIST, in turn.
|
51051
|
117 Then evaluate RESULT to get return value, default nil.
|
|
118
|
51817
|
119 \(fn (VAR LIST [RESULT]) BODY...)"
|
51051
|
120 (declare (indent 1) (debug ((symbolp form &optional form) body)))
|
72096
|
121 ;; It would be cleaner to create an uninterned symbol,
|
|
122 ;; but that uses a lot more space when many functions in many files
|
|
123 ;; use dolist.
|
|
124 (let ((temp '--dolist-tail--))
|
51051
|
125 `(let ((,temp ,(nth 1 spec))
|
|
126 ,(car spec))
|
|
127 (while ,temp
|
|
128 (setq ,(car spec) (car ,temp))
|
72096
|
129 ,@body
|
|
130 (setq ,temp (cdr ,temp)))
|
51051
|
131 ,@(if (cdr (cdr spec))
|
|
132 `((setq ,(car spec) nil) ,@(cdr (cdr spec)))))))
|
27376
|
133
|
72096
|
134 (defvar --dotimes-limit-- nil
|
|
135 "Temporary variable used in `dotimes' expansion.")
|
|
136
|
27376
|
137 (defmacro dotimes (spec &rest body)
|
51051
|
138 "Loop a certain number of times.
|
27376
|
139 Evaluate BODY with VAR bound to successive integers running from 0,
|
|
140 inclusive, to COUNT, exclusive. Then evaluate RESULT to get
|
51051
|
141 the return value (nil if RESULT is omitted).
|
|
142
|
51817
|
143 \(fn (VAR COUNT [RESULT]) BODY...)"
|
51051
|
144 (declare (indent 1) (debug dolist))
|
72096
|
145 ;; It would be cleaner to create an uninterned symbol,
|
|
146 ;; but that uses a lot more space when many functions in many files
|
|
147 ;; use dotimes.
|
|
148 (let ((temp '--dotimes-limit--)
|
51051
|
149 (start 0)
|
|
150 (end (nth 1 spec)))
|
|
151 `(let ((,temp ,end)
|
|
152 (,(car spec) ,start))
|
|
153 (while (< ,(car spec) ,temp)
|
|
154 ,@body
|
|
155 (setq ,(car spec) (1+ ,(car spec))))
|
|
156 ,@(cdr (cdr spec)))))
|
27376
|
157
|
53593
|
158 (defmacro declare (&rest specs)
|
|
159 "Do not evaluate any arguments and return nil.
|
|
160 Treated as a declaration when used at the right place in a
|
55406
|
161 `defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)"
|
53593
|
162 nil)
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
163
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
164 ;;;; Basic Lisp functions.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
165
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
166 (defun ignore (&rest ignore)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
167 "Do nothing and return nil.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
168 This function accepts any number of arguments, but ignores them."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
169 (interactive)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
170 nil)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
171
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
172 (defun error (&rest args)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
173 "Signal an error, making error message by passing all args to `format'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
174 In Emacs, the convention is that error messages start with a capital
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
175 letter but *do not* end with a period. Please follow this convention
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
176 for the sake of consistency."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
177 (while t
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
178 (signal 'error (list (apply 'format args)))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
179
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
180 ;; We put this here instead of in frame.el so that it's defined even on
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
181 ;; systems where frame.el isn't loaded.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
182 (defun frame-configuration-p (object)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
183 "Return non-nil if OBJECT seems to be a frame configuration.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
184 Any list whose car is `frame-configuration' is assumed to be a frame
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
185 configuration."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
186 (and (consp object)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
187 (eq (car object) 'frame-configuration)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
188
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
189 (defun functionp (object)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
190 "Non-nil if OBJECT is any kind of function or a special form.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
191 Also non-nil if OBJECT is a symbol and its function definition is
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
192 \(recursively) a function or special form. This does not include
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
193 macros."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
194 (or (and (symbolp object) (fboundp object)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
195 (condition-case nil
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
196 (setq object (indirect-function object))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
197 (error nil))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
198 (eq (car-safe object) 'autoload)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
199 (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object)))))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
200 (subrp object) (byte-code-function-p object)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
201 (eq (car-safe object) 'lambda)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
202
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
203 ;;;; List functions.
|
53593
|
204
|
19491
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
205 (defsubst caar (x)
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
206 "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>
diff
changeset
|
207 (car (car x)))
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
208
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
209 (defsubst cadr (x)
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
210 "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>
diff
changeset
|
211 (car (cdr x)))
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
212
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
213 (defsubst cdar (x)
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
214 "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>
diff
changeset
|
215 (cdr (car x)))
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
216
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
217 (defsubst cddr (x)
|
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
218 "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>
diff
changeset
|
219 (cdr (cdr x)))
|
19492
|
220
|
55406
|
221 (defun last (list &optional n)
|
|
222 "Return the last link of LIST. Its car is the last element.
|
|
223 If LIST is nil, return nil.
|
|
224 If N is non-nil, return the Nth-to-last link of LIST.
|
|
225 If N is bigger than the length of LIST, return LIST."
|
19584
|
226 (if n
|
55406
|
227 (let ((m 0) (p list))
|
19584
|
228 (while (consp p)
|
|
229 (setq m (1+ m) p (cdr p)))
|
|
230 (if (<= n 0) p
|
55406
|
231 (if (< n m) (nthcdr (- m n) list) list)))
|
|
232 (while (consp (cdr list))
|
|
233 (setq list (cdr list)))
|
|
234 list))
|
22860
|
235
|
55406
|
236 (defun butlast (list &optional n)
|
56537
|
237 "Return a copy of LIST with the last N elements removed."
|
55406
|
238 (if (and n (<= n 0)) list
|
|
239 (nbutlast (copy-sequence list) n)))
|
34898
|
240
|
55406
|
241 (defun nbutlast (list &optional n)
|
34898
|
242 "Modifies LIST to remove the last N elements."
|
55406
|
243 (let ((m (length list)))
|
34898
|
244 (or n (setq n 1))
|
|
245 (and (< n m)
|
|
246 (progn
|
55406
|
247 (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil))
|
|
248 list))))
|
34898
|
249
|
53626
|
250 (defun delete-dups (list)
|
54016
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
diff
changeset
|
251 "Destructively remove `equal' duplicates from LIST.
|
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
diff
changeset
|
252 Store the result in LIST and return it. LIST must be a proper list.
|
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
diff
changeset
|
253 Of several `equal' occurrences of an element in LIST, the first
|
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
diff
changeset
|
254 one is kept."
|
53626
|
255 (let ((tail list))
|
|
256 (while tail
|
54016
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
diff
changeset
|
257 (setcdr tail (delete (car tail) (cdr tail)))
|
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
diff
changeset
|
258 (setq tail (cdr tail))))
|
53626
|
259 list)
|
|
260
|
50449
|
261 (defun number-sequence (from &optional to inc)
|
50415
|
262 "Return a sequence of numbers from FROM to TO (both inclusive) as a list.
|
53174
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
263 INC is the increment used between numbers in the sequence and defaults to 1.
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
264 So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
265 zero. TO is only included if there is an N for which TO = FROM + N * INC.
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
266 If TO is nil or numerically equal to FROM, return \(FROM).
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
267 If INC is positive and TO is less than FROM, or INC is negative
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
268 and TO is larger than FROM, return nil.
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
269 If INC is zero and TO is neither nil nor numerically equal to
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
270 FROM, signal an error.
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
271
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
272 This function is primarily designed for integer arguments.
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
273 Nevertheless, FROM, TO and INC can be integer or float. However,
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
274 floating point arithmetic is inexact. For instance, depending on
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
275 the machine, it may quite well happen that
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
276 \(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4),
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
277 whereas \(number-sequence 0.4 0.8 0.2) returns a list with three
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
278 elements. Thus, if some of the arguments are floats and one wants
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
279 to make sure that TO is included, one may have to explicitly write
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
280 TO as \(+ FROM \(* N INC)) or use a variable whose value was
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
281 computed with this exact expression. Alternatively, you can,
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
282 of course, also replace TO with a slightly larger value
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
283 \(or a slightly more negative value if INC is negative)."
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
284 (if (or (not to) (= from to))
|
50449
|
285 (list from)
|
|
286 (or inc (setq inc 1))
|
53174
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
287 (when (zerop inc) (error "The increment can not be zero"))
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
288 (let (seq (n 0) (next from))
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
289 (if (> inc 0)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
290 (while (<= next to)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
291 (setq seq (cons next seq)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
292 n (1+ n)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
293 next (+ from (* n inc))))
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
294 (while (>= next to)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
295 (setq seq (cons next seq)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
296 n (1+ n)
|
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
297 next (+ from (* n inc)))))
|
50449
|
298 (nreverse seq))))
|
50415
|
299
|
45690
|
300 (defun copy-tree (tree &optional vecp)
|
|
301 "Make a copy of TREE.
|
|
302 If TREE is a cons cell, this recursively copies both its car and its cdr.
|
45740
|
303 Contrast to `copy-sequence', which copies only along the cdrs. With second
|
45690
|
304 argument VECP, this copies vectors as well as conses."
|
|
305 (if (consp tree)
|
45740
|
306 (let (result)
|
|
307 (while (consp tree)
|
|
308 (let ((newcar (car tree)))
|
|
309 (if (or (consp (car tree)) (and vecp (vectorp (car tree))))
|
|
310 (setq newcar (copy-tree (car tree) vecp)))
|
|
311 (push newcar result))
|
|
312 (setq tree (cdr tree)))
|
45821
|
313 (nconc (nreverse result) tree))
|
45690
|
314 (if (and vecp (vectorp tree))
|
|
315 (let ((i (length (setq tree (copy-sequence tree)))))
|
|
316 (while (>= (setq i (1- i)) 0)
|
45740
|
317 (aset tree i (copy-tree (aref tree i) vecp)))
|
|
318 tree)
|
|
319 tree)))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
320
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
321 ;;;; Various list-search functions.
|
45690
|
322
|
22959
|
323 (defun assoc-default (key alist &optional test default)
|
|
324 "Find object KEY in a pseudo-alist ALIST.
|
|
325 ALIST is a list of conses or objects. Each element (or the element's car,
|
|
326 if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY).
|
|
327 If that is non-nil, the element matches;
|
|
328 then `assoc-default' returns the element's cdr, if it is a cons,
|
22860
|
329 or DEFAULT if the element is not a cons.
|
22959
|
330
|
|
331 If no element matches, the value is nil.
|
|
332 If TEST is omitted or nil, `equal' is used."
|
|
333 (let (found (tail alist) value)
|
|
334 (while (and tail (not found))
|
|
335 (let ((elt (car tail)))
|
|
336 (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
|
|
337 (setq found t value (if (consp elt) (cdr elt) default))))
|
|
338 (setq tail (cdr tail)))
|
|
339 value))
|
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
340
|
53412
|
341 (make-obsolete 'assoc-ignore-case 'assoc-string)
|
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
342 (defun assoc-ignore-case (key alist)
|
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
343 "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>
diff
changeset
|
344 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>
diff
changeset
|
345 Unibyte strings are converted to multibyte for comparison."
|
53412
|
346 (assoc-string key alist t))
|
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
347
|
53412
|
348 (make-obsolete 'assoc-ignore-representation 'assoc-string)
|
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
349 (defun assoc-ignore-representation (key alist)
|
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
350 "Like `assoc', but ignores differences in text representation.
|
47916
|
351 KEY must be a string.
|
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
352 Unibyte strings are converted to multibyte for comparison."
|
53412
|
353 (assoc-string key alist nil))
|
28490
|
354
|
|
355 (defun member-ignore-case (elt list)
|
|
356 "Like `member', but ignores differences in case and text representation.
|
|
357 ELT must be a string. Upper-case and lower-case letters are treated as equal.
|
44900
|
358 Unibyte strings are converted to multibyte for comparison.
|
|
359 Non-strings in LIST are ignored."
|
|
360 (while (and list
|
|
361 (not (and (stringp (car list))
|
|
362 (eq t (compare-strings elt 0 nil (car list) 0 nil t)))))
|
33978
|
363 (setq list (cdr list)))
|
|
364 list)
|
28490
|
365
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
366 (defun assq-delete-all (key alist)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
367 "Delete from ALIST all elements whose car is `eq' to KEY.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
368 Return the modified alist.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
369 Elements of ALIST that are not conses are ignored."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
370 (while (and (consp (car alist))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
371 (eq (car (car alist)) key))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
372 (setq alist (cdr alist)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
373 (let ((tail alist) tail-cdr)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
374 (while (setq tail-cdr (cdr tail))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
375 (if (and (consp (car tail-cdr))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
376 (eq (car (car tail-cdr)) key))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
377 (setcdr tail (cdr tail-cdr))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
378 (setq tail tail-cdr))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
379 alist)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
380
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
381 (defun rassq-delete-all (value alist)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
382 "Delete from ALIST all elements whose cdr is `eq' to VALUE.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
383 Return the modified alist.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
384 Elements of ALIST that are not conses are ignored."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
385 (while (and (consp (car alist))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
386 (eq (cdr (car alist)) value))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
387 (setq alist (cdr alist)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
388 (let ((tail alist) tail-cdr)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
389 (while (setq tail-cdr (cdr tail))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
390 (if (and (consp (car tail-cdr))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
391 (eq (cdr (car tail-cdr)) value))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
392 (setcdr tail (cdr tail-cdr))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
393 (setq tail tail-cdr))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
394 alist)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
395
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
396 (defun remove (elt seq)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
397 "Return a copy of SEQ with all occurrences of ELT removed.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
398 SEQ must be a list, vector, or string. The comparison is done with `equal'."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
399 (if (nlistp seq)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
400 ;; If SEQ isn't a list, there's no need to copy SEQ because
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
401 ;; `delete' will return a new object.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
402 (delete elt seq)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
403 (delete elt (copy-sequence seq))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
404
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
405 (defun remq (elt list)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
406 "Return LIST with all occurrences of ELT removed.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
407 The comparison is done with `eq'. Contrary to `delq', this does not use
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
408 side-effects, and the argument LIST is not modified."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
409 (if (memq elt list)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
410 (delq elt (copy-sequence list))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
411 list))
|
2504
|
412
|
|
413 ;;;; Keymap support.
|
114
|
414
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
415 (defmacro kbd (keys)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
416 "Convert KEYS to the internal Emacs key representation.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
417 KEYS should be a string constant in the format used for
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
418 saving keyboard macros (see `edmacro-mode')."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
419 (read-kbd-macro keys))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
420
|
114
|
421 (defun undefined ()
|
|
422 (interactive)
|
|
423 (ding))
|
|
424
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
425 ;; Prevent the \{...} documentation construct
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
426 ;; from mentioning keys that run this command.
|
114
|
427 (put 'undefined 'suppress-keymap t)
|
|
428
|
|
429 (defun suppress-keymap (map &optional nodigits)
|
|
430 "Make MAP override all normally self-inserting keys to be undefined.
|
|
431 Normally, as an exception, digits and minus-sign are set to make prefix args,
|
|
432 but optional second arg NODIGITS non-nil treats them like other chars."
|
47042
|
433 (define-key map [remap self-insert-command] 'undefined)
|
114
|
434 (or nodigits
|
|
435 (let (loop)
|
|
436 (define-key map "-" 'negative-argument)
|
|
437 ;; Make plain numbers do numeric args.
|
|
438 (setq loop ?0)
|
|
439 (while (<= loop ?9)
|
|
440 (define-key map (char-to-string loop) 'digit-argument)
|
|
441 (setq loop (1+ loop))))))
|
|
442
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
443 (defun define-key-after (keymap key definition &optional after)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
444 "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
445 This is like `define-key' except that the binding for KEY is placed
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
446 just after the binding for the event AFTER, instead of at the beginning
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
447 of the map. Note that AFTER must be an event type (like KEY), NOT a command
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
448 \(like DEFINITION).
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
449
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
450 If AFTER is t or omitted, the new binding goes at the end of the keymap.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
451 AFTER should be a single event type--a symbol or a character, not a sequence.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
452
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
453 Bindings are always added before any inherited map.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
454
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
455 The order of bindings in a keymap matters when it is used as a menu."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
456 (unless after (setq after t))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
457 (or (keymapp keymap)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
458 (signal 'wrong-type-argument (list 'keymapp keymap)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
459 (setq key
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
460 (if (<= (length key) 1) (aref key 0)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
461 (setq keymap (lookup-key keymap
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
462 (apply 'vector
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
463 (butlast (mapcar 'identity key)))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
464 (aref key (1- (length key)))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
465 (let ((tail keymap) done inserted)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
466 (while (and (not done) tail)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
467 ;; Delete any earlier bindings for the same key.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
468 (if (eq (car-safe (car (cdr tail))) key)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
469 (setcdr tail (cdr (cdr tail))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
470 ;; If we hit an included map, go down that one.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
471 (if (keymapp (car tail)) (setq tail (car tail)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
472 ;; When we reach AFTER's binding, insert the new binding after.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
473 ;; If we reach an inherited keymap, insert just before that.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
474 ;; If we reach the end of this keymap, insert at the end.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
475 (if (or (and (eq (car-safe (car tail)) after)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
476 (not (eq after t)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
477 (eq (car (cdr tail)) 'keymap)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
478 (null (cdr tail)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
479 (progn
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
480 ;; Stop the scan only if we find a parent keymap.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
481 ;; Keep going past the inserted element
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
482 ;; so we can delete any duplications that come later.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
483 (if (eq (car (cdr tail)) 'keymap)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
484 (setq done t))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
485 ;; Don't insert more than once.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
486 (or inserted
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
487 (setcdr tail (cons (cons key definition) (cdr tail))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
488 (setq inserted t)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
489 (setq tail (cdr tail)))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
490
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
491 (defun map-keymap-internal (function keymap &optional sort-first)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
492 "Implement `map-keymap' with sorting.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
493 Don't call this function; it is for internal use only."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
494 (if sort-first
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
495 (let (list)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
496 (map-keymap (lambda (a b) (push (cons a b) list))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
497 keymap)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
498 (setq list (sort list
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
499 (lambda (a b)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
500 (setq a (car a) b (car b))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
501 (if (integerp a)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
502 (if (integerp b) (< a b)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
503 t)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
504 (if (integerp b) t
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
505 (string< a b))))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
506 (dolist (p list)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
507 (funcall function (car p) (cdr p))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
508 (map-keymap function keymap)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
509
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
510 (put 'keyboard-translate-table 'char-table-extra-slots 0)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
511
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
512 (defun keyboard-translate (from to)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
513 "Translate character FROM to TO at a low level.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
514 This function creates a `keyboard-translate-table' if necessary
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
515 and then modifies one entry in it."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
516 (or (char-table-p keyboard-translate-table)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
517 (setq keyboard-translate-table
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
518 (make-char-table 'keyboard-translate-table nil)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
519 (aset keyboard-translate-table from to))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
520
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
521 ;;;; Key binding commands.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
522
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
523 (defun global-set-key (key command)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
524 "Give KEY a global binding as COMMAND.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
525 COMMAND is the command definition to use; usually it is
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
526 a symbol naming an interactively-callable function.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
527 KEY is a key sequence; noninteractively, it is a string or vector
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
528 of characters or event types, and non-ASCII characters with codes
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
529 above 127 (such as ISO Latin-1) can be included if you use a vector.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
530
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
531 Note that if KEY has a local binding in the current buffer,
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
532 that local binding will continue to shadow any global binding
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
533 that you make with this function."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
534 (interactive "KSet key globally: \nCSet key %s to command: ")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
535 (or (vectorp key) (stringp key)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
536 (signal 'wrong-type-argument (list 'arrayp key)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
537 (define-key (current-global-map) key command))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
538
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
539 (defun local-set-key (key command)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
540 "Give KEY a local binding as COMMAND.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
541 COMMAND is the command definition to use; usually it is
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
542 a symbol naming an interactively-callable function.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
543 KEY is a key sequence; noninteractively, it is a string or vector
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
544 of characters or event types, and non-ASCII characters with codes
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
545 above 127 (such as ISO Latin-1) can be included if you use a vector.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
546
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
547 The binding goes in the current buffer's local map,
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
548 which in most cases is shared with all other buffers in the same major mode."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
549 (interactive "KSet key locally: \nCSet key %s locally to command: ")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
550 (let ((map (current-local-map)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
551 (or map
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
552 (use-local-map (setq map (make-sparse-keymap))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
553 (or (vectorp key) (stringp key)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
554 (signal 'wrong-type-argument (list 'arrayp key)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
555 (define-key map key command)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
556
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
557 (defun global-unset-key (key)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
558 "Remove global binding of KEY.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
559 KEY is a string or vector representing a sequence of keystrokes."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
560 (interactive "kUnset key globally: ")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
561 (global-set-key key nil))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
562
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
563 (defun local-unset-key (key)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
564 "Remove local binding of KEY.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
565 KEY is a string or vector representing a sequence of keystrokes."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
566 (interactive "kUnset key locally: ")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
567 (if (current-local-map)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
568 (local-set-key key nil))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
569 nil)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
570
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
571 ;;;; substitute-key-definition and its subroutines.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
572
|
6167
|
573 (defvar key-substitution-in-progress nil
|
63634
|
574 "Used internally by `substitute-key-definition'.")
|
6167
|
575
|
61967
|
576 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
|
|
577 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
|
|
578 In other words, OLDDEF is replaced with NEWDEF where ever it appears.
|
|
579 Alternatively, if optional fourth argument OLDMAP is specified, we redefine
|
|
580 in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP.
|
|
581
|
68830
|
582 If you don't specify OLDMAP, you can usually get the same results
|
|
583 in a cleaner way with command remapping, like this:
|
68848
f038d760daf1
(substitute-key-definition): Doc fix (hide internal argument).
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
584 \(define-key KEYMAP [remap OLDDEF] NEWDEF)
|
f038d760daf1
(substitute-key-definition): Doc fix (hide internal argument).
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
585 \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
|
28868
|
586 ;; Don't document PREFIX in the doc string because we don't want to
|
|
587 ;; advertise it. It's meant for recursive calls only. Here's its
|
|
588 ;; meaning
|
47916
|
589
|
28868
|
590 ;; If optional argument PREFIX is specified, it should be a key
|
|
591 ;; prefix, a string. Redefined bindings will then be bound to the
|
|
592 ;; original key, with PREFIX added at the front.
|
1176
|
593 (or prefix (setq prefix ""))
|
|
594 (let* ((scan (or oldmap keymap))
|
57480
|
595 (prefix1 (vconcat prefix [nil]))
|
6167
|
596 (key-substitution-in-progress
|
|
597 (cons scan key-substitution-in-progress)))
|
1176
|
598 ;; Scan OLDMAP, finding each char or event-symbol that
|
|
599 ;; has any definition, and act on it with hack-key.
|
57480
|
600 (map-keymap
|
|
601 (lambda (char defn)
|
|
602 (aset prefix1 (length prefix) char)
|
61967
|
603 (substitute-key-definition-key defn olddef newdef prefix1 keymap))
|
57480
|
604 scan)))
|
|
605
|
61967
|
606 (defun substitute-key-definition-key (defn olddef newdef prefix keymap)
|
|
607 (let (inner-def skipped menu-item)
|
57480
|
608 ;; Find the actual command name within the binding.
|
|
609 (if (eq (car-safe defn) 'menu-item)
|
|
610 (setq menu-item defn defn (nth 2 defn))
|
|
611 ;; Skip past menu-prompt.
|
|
612 (while (stringp (car-safe defn))
|
|
613 (push (pop defn) skipped))
|
|
614 ;; Skip past cached key-equivalence data for menu items.
|
|
615 (if (consp (car-safe defn))
|
|
616 (setq defn (cdr defn))))
|
61967
|
617 (if (or (eq defn olddef)
|
57480
|
618 ;; Compare with equal if definition is a key sequence.
|
|
619 ;; That is useful for operating on function-key-map.
|
|
620 (and (or (stringp defn) (vectorp defn))
|
61967
|
621 (equal defn olddef)))
|
57480
|
622 (define-key keymap prefix
|
|
623 (if menu-item
|
|
624 (let ((copy (copy-sequence menu-item)))
|
61967
|
625 (setcar (nthcdr 2 copy) newdef)
|
57480
|
626 copy)
|
61967
|
627 (nconc (nreverse skipped) newdef)))
|
57480
|
628 ;; Look past a symbol that names a keymap.
|
|
629 (setq inner-def
|
68759
|
630 (or (indirect-function defn t) defn))
|
57480
|
631 ;; For nested keymaps, we use `inner-def' rather than `defn' so as to
|
|
632 ;; avoid autoloading a keymap. This is mostly done to preserve the
|
|
633 ;; original non-autoloading behavior of pre-map-keymap times.
|
|
634 (if (and (keymapp inner-def)
|
|
635 ;; Avoid recursively scanning
|
|
636 ;; where KEYMAP does not have a submap.
|
|
637 (let ((elt (lookup-key keymap prefix)))
|
|
638 (or (null elt) (natnump elt) (keymapp elt)))
|
|
639 ;; Avoid recursively rescanning keymap being scanned.
|
|
640 (not (memq inner-def key-substitution-in-progress)))
|
|
641 ;; If this one isn't being scanned already, scan it now.
|
61967
|
642 (substitute-key-definition olddef newdef keymap inner-def prefix)))))
|
2504
|
643
|
2071
|
644
|
47916
|
645 ;;;; The global keymap tree.
|
2504
|
646
|
|
647 ;;; global-map, esc-map, and ctl-x-map have their values set up in
|
|
648 ;;; keymap.c; we just give them docstrings here.
|
|
649
|
|
650 (defvar global-map nil
|
|
651 "Default global keymap mapping Emacs keyboard input into commands.
|
|
652 The value is a keymap which is usually (but not necessarily) Emacs's
|
|
653 global map.")
|
|
654
|
|
655 (defvar esc-map nil
|
|
656 "Default keymap for ESC (meta) commands.
|
|
657 The normal global definition of the character ESC indirects to this keymap.")
|
|
658
|
|
659 (defvar ctl-x-map nil
|
|
660 "Default keymap for C-x commands.
|
|
661 The normal global definition of the character C-x indirects to this keymap.")
|
|
662
|
|
663 (defvar ctl-x-4-map (make-sparse-keymap)
|
41955
|
664 "Keymap for subcommands of C-x 4.")
|
2569
|
665 (defalias 'ctl-x-4-prefix ctl-x-4-map)
|
2504
|
666 (define-key ctl-x-map "4" 'ctl-x-4-prefix)
|
|
667
|
|
668 (defvar ctl-x-5-map (make-sparse-keymap)
|
|
669 "Keymap for frame commands.")
|
2569
|
670 (defalias 'ctl-x-5-prefix ctl-x-5-map)
|
2504
|
671 (define-key ctl-x-map "5" 'ctl-x-5-prefix)
|
|
672
|
|
673
|
|
674 ;;;; Event manipulation functions.
|
|
675
|
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
676 ;; 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>
diff
changeset
|
677 ;; 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>
diff
changeset
|
678 ;; machines, but not on all!
|
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
679 (defconst listify-key-sequence-1 (logior 128 (read "?\\M-\\^@")))
|
3153
|
680
|
2021
|
681 (defun listify-key-sequence (key)
|
|
682 "Convert a key sequence to a list of events."
|
|
683 (if (vectorp key)
|
|
684 (append key nil)
|
|
685 (mapcar (function (lambda (c)
|
|
686 (if (> c 127)
|
3153
|
687 (logxor c listify-key-sequence-1)
|
2021
|
688 c)))
|
51051
|
689 key)))
|
2021
|
690
|
2040
|
691 (defsubst eventp (obj)
|
|
692 "True if the argument is an event object."
|
55520
|
693 (or (and (integerp obj)
|
|
694 ;; Filter out integers too large to be events.
|
|
695 ;; M is the biggest modifier.
|
|
696 (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1)))))
|
|
697 (char-valid-p (event-basic-type obj)))
|
2040
|
698 (and (symbolp obj)
|
|
699 (get obj 'event-symbol-elements))
|
|
700 (and (consp obj)
|
|
701 (symbolp (car obj))
|
|
702 (get (car obj) 'event-symbol-elements))))
|
|
703
|
|
704 (defun event-modifiers (event)
|
56537
|
705 "Return a list of symbols representing the modifier keys in event EVENT.
|
2040
|
706 The elements of the list may include `meta', `control',
|
4414
|
707 `shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
|
56570
|
708 and `down'.
|
|
709 EVENT may be an event or an event type. If EVENT is a symbol
|
|
710 that has never been used in an event that has been read as input
|
|
711 in the current Emacs session, then this function can return nil,
|
|
712 even when EVENT actually has modifiers."
|
2040
|
713 (let ((type event))
|
|
714 (if (listp type)
|
|
715 (setq type (car type)))
|
|
716 (if (symbolp type)
|
|
717 (cdr (get type 'event-symbol-elements))
|
55013
|
718 (let ((list nil)
|
|
719 (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@
|
|
720 ?\H-\^@ ?\s-\^@ ?\A-\^@)))))
|
|
721 (if (not (zerop (logand type ?\M-\^@)))
|
57480
|
722 (push 'meta list))
|
55013
|
723 (if (or (not (zerop (logand type ?\C-\^@)))
|
|
724 (< char 32))
|
57480
|
725 (push 'control list))
|
55013
|
726 (if (or (not (zerop (logand type ?\S-\^@)))
|
|
727 (/= char (downcase char)))
|
57480
|
728 (push 'shift list))
|
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
729 (or (zerop (logand type ?\H-\^@))
|
57480
|
730 (push 'hyper list))
|
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
731 (or (zerop (logand type ?\s-\^@))
|
57480
|
732 (push 'super list))
|
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
733 (or (zerop (logand type ?\A-\^@))
|
57480
|
734 (push 'alt list))
|
2040
|
735 list))))
|
|
736
|
2063
|
737 (defun event-basic-type (event)
|
56537
|
738 "Return the basic type of the given event (all modifiers removed).
|
56570
|
739 The value is a printing character (not upper case) or a symbol.
|
|
740 EVENT may be an event or an event type. If EVENT is a symbol
|
|
741 that has never been used in an event that has been read as input
|
|
742 in the current Emacs session, then this function may return nil."
|
3784
|
743 (if (consp event)
|
|
744 (setq event (car event)))
|
2063
|
745 (if (symbolp event)
|
|
746 (car (get event 'event-symbol-elements))
|
62524
|
747 (let* ((base (logand event (1- ?\A-\^@)))
|
|
748 (uncontrolled (if (< base 32) (logior base 64) base)))
|
|
749 ;; There are some numbers that are invalid characters and
|
|
750 ;; cause `downcase' to get an error.
|
|
751 (condition-case ()
|
|
752 (downcase uncontrolled)
|
|
753 (error uncontrolled)))))
|
2063
|
754
|
2071
|
755 (defsubst mouse-movement-p (object)
|
|
756 "Return non-nil if OBJECT is a mouse movement event."
|
57480
|
757 (eq (car-safe object) 'mouse-movement))
|
2071
|
758
|
|
759 (defsubst event-start (event)
|
|
760 "Return the starting position of EVENT.
|
54866
|
761 If EVENT is a mouse or key press or a mouse click, this returns the location
|
2071
|
762 of the event.
|
|
763 If EVENT is a drag, this returns the drag's starting position.
|
|
764 The return value is of the form
|
53518
|
765 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
|
|
766 IMAGE (DX . DY) (WIDTH . HEIGHT))
|
2071
|
767 The `posn-' functions access elements of such lists."
|
45978
|
768 (if (consp event) (nth 1 event)
|
|
769 (list (selected-window) (point) '(0 . 0) 0)))
|
2071
|
770
|
|
771 (defsubst event-end (event)
|
54866
|
772 "Return the ending location of EVENT.
|
|
773 EVENT should be a click, drag, or key press event.
|
2071
|
774 If EVENT is a click event, this function is the same as `event-start'.
|
|
775 The return value is of the form
|
53518
|
776 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW)
|
|
777 IMAGE (DX . DY) (WIDTH . HEIGHT))
|
2071
|
778 The `posn-' functions access elements of such lists."
|
45978
|
779 (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event)
|
|
780 (list (selected-window) (point) '(0 . 0) 0)))
|
2071
|
781
|
4414
|
782 (defsubst event-click-count (event)
|
|
783 "Return the multi-click count of EVENT, a click or drag event.
|
|
784 The return value is a positive integer."
|
45978
|
785 (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
786
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
787 ;;;; Extracting fields of the positions in an event.
|
4414
|
788
|
2071
|
789 (defsubst posn-window (position)
|
|
790 "Return the window in POSITION.
|
53132
|
791 POSITION should be a list of the form returned by the `event-start'
|
53593
|
792 and `event-end' functions."
|
2071
|
793 (nth 0 position))
|
|
794
|
53132
|
795 (defsubst posn-area (position)
|
|
796 "Return the window area recorded in POSITION, or nil for the text area.
|
|
797 POSITION should be a list of the form returned by the `event-start'
|
53593
|
798 and `event-end' functions."
|
53132
|
799 (let ((area (if (consp (nth 1 position))
|
|
800 (car (nth 1 position))
|
|
801 (nth 1 position))))
|
|
802 (and (symbolp area) area)))
|
|
803
|
2071
|
804 (defsubst posn-point (position)
|
|
805 "Return the buffer location in POSITION.
|
53132
|
806 POSITION should be a list of the form returned by the `event-start'
|
53593
|
807 and `event-end' functions."
|
53132
|
808 (or (nth 5 position)
|
|
809 (if (consp (nth 1 position))
|
|
810 (car (nth 1 position))
|
|
811 (nth 1 position))))
|
2071
|
812
|
54866
|
813 (defun posn-set-point (position)
|
|
814 "Move point to POSITION.
|
|
815 Select the corresponding window as well."
|
54887
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
816 (if (not (windowp (posn-window position)))
|
54866
|
817 (error "Position not in text area of window"))
|
54887
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
818 (select-window (posn-window position))
|
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
819 (if (numberp (posn-point position))
|
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
820 (goto-char (posn-point position))))
|
54866
|
821
|
6039
|
822 (defsubst posn-x-y (position)
|
|
823 "Return the x and y coordinates in POSITION.
|
53132
|
824 POSITION should be a list of the form returned by the `event-start'
|
53593
|
825 and `event-end' functions."
|
2071
|
826 (nth 2 position))
|
|
827
|
7636
|
828 (defun posn-col-row (position)
|
53132
|
829 "Return the nominal column and row in POSITION, measured in characters.
|
|
830 The column and row values are approximations calculated from the x
|
|
831 and y coordinates in POSITION and the frame's default character width
|
53593
|
832 and height.
|
7636
|
833 For a scroll-bar event, the result column is 0, and the row
|
53132
|
834 corresponds to the vertical position of the click in the scroll bar.
|
|
835 POSITION should be a list of the form returned by the `event-start'
|
53593
|
836 and `event-end' functions."
|
53132
|
837 (let* ((pair (posn-x-y position))
|
|
838 (window (posn-window position))
|
|
839 (area (posn-area position)))
|
|
840 (cond
|
|
841 ((null window)
|
|
842 '(0 . 0))
|
|
843 ((eq area 'vertical-scroll-bar)
|
|
844 (cons 0 (scroll-bar-scale pair (1- (window-height window)))))
|
|
845 ((eq area 'horizontal-scroll-bar)
|
|
846 (cons (scroll-bar-scale pair (window-width window)) 0))
|
|
847 (t
|
|
848 (let* ((frame (if (framep window) window (window-frame window)))
|
|
849 (x (/ (car pair) (frame-char-width frame)))
|
|
850 (y (/ (cdr pair) (+ (frame-char-height frame)
|
|
851 (or (frame-parameter frame 'line-spacing)
|
|
852 default-line-spacing
|
|
853 0)))))
|
|
854 (cons x y))))))
|
|
855
|
|
856 (defun posn-actual-col-row (position)
|
|
857 "Return the actual column and row in POSITION, measured in characters.
|
|
858 These are the actual row number in the window and character number in that row.
|
|
859 Return nil if POSITION does not contain the actual position; in that case
|
|
860 `posn-col-row' can be used to get approximate values.
|
|
861 POSITION should be a list of the form returned by the `event-start'
|
53593
|
862 and `event-end' functions."
|
53132
|
863 (nth 6 position))
|
6039
|
864
|
2071
|
865 (defsubst posn-timestamp (position)
|
|
866 "Return the timestamp of POSITION.
|
53132
|
867 POSITION should be a list of the form returned by the `event-start'
|
53593
|
868 and `event-end' functions."
|
2071
|
869 (nth 3 position))
|
2504
|
870
|
53518
|
871 (defsubst posn-string (position)
|
70229
|
872 "Return the string object of POSITION.
|
|
873 Value is a cons (STRING . STRING-POS), or nil if not a string.
|
53132
|
874 POSITION should be a list of the form returned by the `event-start'
|
53593
|
875 and `event-end' functions."
|
53132
|
876 (nth 4 position))
|
|
877
|
53518
|
878 (defsubst posn-image (position)
|
70229
|
879 "Return the image object of POSITION.
|
74085
|
880 Value is a list (image ...), or nil if not an image.
|
53518
|
881 POSITION should be a list of the form returned by the `event-start'
|
53593
|
882 and `event-end' functions."
|
53518
|
883 (nth 7 position))
|
|
884
|
|
885 (defsubst posn-object (position)
|
|
886 "Return the object (image or string) of POSITION.
|
70229
|
887 Value is a list (image ...) for an image object, a cons cell
|
|
888 \(STRING . STRING-POS) for a string object, and nil for a buffer position.
|
53518
|
889 POSITION should be a list of the form returned by the `event-start'
|
53593
|
890 and `event-end' functions."
|
53518
|
891 (or (posn-image position) (posn-string position)))
|
|
892
|
53181
|
893 (defsubst posn-object-x-y (position)
|
|
894 "Return the x and y coordinates relative to the object of POSITION.
|
|
895 POSITION should be a list of the form returned by the `event-start'
|
53593
|
896 and `event-end' functions."
|
53518
|
897 (nth 8 position))
|
|
898
|
|
899 (defsubst posn-object-width-height (position)
|
|
900 "Return the pixel width and height of the object of POSITION.
|
|
901 POSITION should be a list of the form returned by the `event-start'
|
53593
|
902 and `event-end' functions."
|
53518
|
903 (nth 9 position))
|
53181
|
904
|
2071
|
905
|
2504
|
906 ;;;; Obsolescent names for functions.
|
|
907
|
62542
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
908 (define-obsolete-function-alias 'window-dot 'window-point "22.1")
|
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
909 (define-obsolete-function-alias 'set-window-dot 'set-window-point "22.1")
|
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
910 (define-obsolete-function-alias 'read-input 'read-string "22.1")
|
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
911 (define-obsolete-function-alias 'show-buffer 'set-window-buffer "22.1")
|
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
912 (define-obsolete-function-alias 'eval-current-buffer 'eval-buffer "22.1")
|
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
913 (define-obsolete-function-alias 'string-to-int 'string-to-number "22.1")
|
114
|
914
|
47652
|
915 (make-obsolete 'char-bytes "now always returns 1." "20.4")
|
20605
|
916
|
42266
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
917 (defun insert-string (&rest args)
|
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
918 "Mocklisp-compatibility insert function.
|
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
919 Like the function `insert' except that any argument that is a number
|
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
920 is converted into a string by expressing it in decimal."
|
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
921 (dolist (el args)
|
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
922 (insert (if (integerp el) (number-to-string el) el))))
|
59996
|
923 (make-obsolete 'insert-string 'insert "22.1")
|
62430
a25a4c4602a4
Slight reorganization of some obsolete declarations; deleted comment no longer
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
924
|
46219
|
925 (defun makehash (&optional test) (make-hash-table :test (or test 'eql)))
|
59996
|
926 (make-obsolete 'makehash 'make-hash-table "22.1")
|
42266
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
diff
changeset
|
927
|
2504
|
928 ;; Some programs still use this as a function.
|
|
929 (defun baud-rate ()
|
46052
|
930 "Return the value of the `baud-rate' variable."
|
2504
|
931 baud-rate)
|
62430
a25a4c4602a4
Slight reorganization of some obsolete declarations; deleted comment no longer
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
932 (make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15")
|
2504
|
933
|
62608
ad7518f065e5
(focus-frame, unfocus-frame): Revert deletion on 2005-05-01.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
934 ;; These are used by VM and some old programs
|
ad7518f065e5
(focus-frame, unfocus-frame): Revert deletion on 2005-05-01.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
935 (defalias 'focus-frame 'ignore "")
|
ad7518f065e5
(focus-frame, unfocus-frame): Revert deletion on 2005-05-01.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
936 (make-obsolete 'focus-frame "it does nothing." "22.1")
|
ad7518f065e5
(focus-frame, unfocus-frame): Revert deletion on 2005-05-01.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
937 (defalias 'unfocus-frame 'ignore "")
|
ad7518f065e5
(focus-frame, unfocus-frame): Revert deletion on 2005-05-01.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
938 (make-obsolete 'unfocus-frame "it does nothing." "22.1")
|
ad7518f065e5
(focus-frame, unfocus-frame): Revert deletion on 2005-05-01.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
939
|
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
940
|
59124
|
941 ;;;; Obsolescence declarations for variables, and aliases.
|
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
942
|
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
943 (make-obsolete-variable 'directory-sep-char "do not use it." "21.1")
|
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
944 (make-obsolete-variable 'mode-line-inverse-video "use the appropriate faces instead." "21.1")
|
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
945 (make-obsolete-variable 'unread-command-char
|
74597
|
946 "use `unread-command-events' instead. That variable is a list of events
|
|
947 to reread, so it now uses nil to mean `no event', instead of -1."
|
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
948 "before 19.15")
|
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
949
|
62015
|
950 ;; Lisp manual only updated in 22.1.
|
|
951 (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
|
|
952 "before 19.34")
|
|
953
|
57778
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
954 (defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
|
59996
|
955 (make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "22.1")
|
57778
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
956 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
|
59996
|
957 (make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "22.1")
|
59124
|
958
|
|
959 (defvaralias 'messages-buffer-max-lines 'message-log-max)
|
2504
|
960
|
|
961 ;;;; Alternate names for functions - these are not being phased out.
|
|
962
|
62542
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
963 (defalias 'send-string 'process-send-string)
|
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
964 (defalias 'send-region 'process-send-region)
|
2569
|
965 (defalias 'string= 'string-equal)
|
|
966 (defalias 'string< 'string-lessp)
|
|
967 (defalias 'move-marker 'set-marker)
|
|
968 (defalias 'rplaca 'setcar)
|
|
969 (defalias 'rplacd 'setcdr)
|
3591
|
970 (defalias 'beep 'ding) ;preserve lingual purity
|
2569
|
971 (defalias 'indent-to-column 'indent-to)
|
|
972 (defalias 'backward-delete-char 'delete-backward-char)
|
|
973 (defalias 'search-forward-regexp (symbol-function 're-search-forward))
|
|
974 (defalias 'search-backward-regexp (symbol-function 're-search-backward))
|
|
975 (defalias 'int-to-string 'number-to-string)
|
21173
|
976 (defalias 'store-match-data 'set-match-data)
|
47078
6e9df2174ee2
(make-variable-frame-localizable): New alias for `make-variable-frame-local'.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
977 (defalias 'make-variable-frame-localizable 'make-variable-frame-local)
|
31563
|
978 ;; These are the XEmacs names:
|
25293
|
979 (defalias 'point-at-eol 'line-end-position)
|
|
980 (defalias 'point-at-bol 'line-beginning-position)
|
1903
|
981
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
982 (defalias 'user-original-login-name 'user-login-name)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
983
|
114
|
984
|
2504
|
985 ;;;; Hook manipulation functions.
|
388
|
986
|
9195
|
987 (defun make-local-hook (hook)
|
|
988 "Make the hook HOOK local to the current buffer.
|
23786
|
989 The return value is HOOK.
|
|
990
|
33707
|
991 You never need to call this function now that `add-hook' does it for you
|
|
992 if its LOCAL argument is non-nil.
|
|
993
|
9195
|
994 When a hook is local, its local and global values
|
|
995 work in concert: running the hook actually runs all the hook
|
|
996 functions listed in *either* the local value *or* the global value
|
|
997 of the hook variable.
|
|
998
|
39557
|
999 This function works by making t a member of the buffer-local value,
|
12258
|
1000 which acts as a flag to run the hook functions in the default value as
|
|
1001 well. This works for all normal hooks, but does not work for most
|
|
1002 non-normal hooks yet. We will be changing the callers of non-normal
|
|
1003 hooks so that they can handle localness; this has to be done one by
|
|
1004 one.
|
|
1005
|
|
1006 This function does nothing if HOOK is already local in the current
|
|
1007 buffer.
|
9195
|
1008
|
|
1009 Do not use `make-local-variable' to make a hook variable buffer-local."
|
|
1010 (if (local-variable-p hook)
|
|
1011 nil
|
|
1012 (or (boundp hook) (set hook nil))
|
|
1013 (make-local-variable hook)
|
23786
|
1014 (set hook (list t)))
|
|
1015 hook)
|
46052
|
1016 (make-obsolete 'make-local-hook "not necessary any more." "21.1")
|
9195
|
1017
|
|
1018 (defun add-hook (hook function &optional append local)
|
4414
|
1019 "Add to the value of HOOK the function FUNCTION.
|
|
1020 FUNCTION is not added if already present.
|
|
1021 FUNCTION is added (if necessary) at the beginning of the hook list
|
|
1022 unless the optional argument APPEND is non-nil, in which case
|
|
1023 FUNCTION is added at the end.
|
|
1024
|
9195
|
1025 The optional fourth argument, LOCAL, if non-nil, says to modify
|
|
1026 the hook's buffer-local value rather than its default value.
|
43435
|
1027 This makes the hook buffer-local if needed, and it makes t a member
|
|
1028 of the buffer-local value. That acts as a flag to run the hook
|
|
1029 functions in the default value as well as in the local value.
|
9195
|
1030
|
4414
|
1031 HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
1032 HOOK is void, it is first set to nil. If HOOK's value is a single
|
8959
|
1033 function, it is changed to a list of functions."
|
114
|
1034 (or (boundp hook) (set hook nil))
|
9195
|
1035 (or (default-boundp hook) (set-default hook nil))
|
39557
|
1036 (if local (unless (local-variable-if-set-p hook)
|
|
1037 (set (make-local-variable hook) (list t)))
|
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1038 ;; 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>
diff
changeset
|
1039 ;; and do what we used to do.
|
52987
|
1040 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
|
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1041 (setq local t)))
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1042 (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>
diff
changeset
|
1043 ;; 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>
diff
changeset
|
1044 (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
|
28940
|
1045 (setq hook-value (list hook-value)))
|
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1046 ;; Do the actual addition if necessary
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1047 (unless (member function hook-value)
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1048 (setq hook-value
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1049 (if append
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1050 (append hook-value (list function))
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1051 (cons function hook-value))))
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1052 ;; Set the actual variable
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1053 (if local (set hook hook-value) (set-default hook hook-value))))
|
2504
|
1054
|
9195
|
1055 (defun remove-hook (hook function &optional local)
|
4964
|
1056 "Remove from the value of HOOK the function FUNCTION.
|
|
1057 HOOK should be a symbol, and FUNCTION may be any valid function. If
|
|
1058 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
|
9195
|
1059 list of hooks to run in HOOK, then nothing is done. See `add-hook'.
|
|
1060
|
|
1061 The optional third argument, LOCAL, if non-nil, says to modify
|
52896
|
1062 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>
diff
changeset
|
1063 (or (boundp hook) (set hook nil))
|
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1064 (or (default-boundp hook) (set-default hook nil))
|
52896
|
1065 ;; Do nothing if LOCAL is t but this hook has no local binding.
|
|
1066 (unless (and local (not (local-variable-p hook)))
|
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1067 ;; 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>
diff
changeset
|
1068 ;; and do what we used to do.
|
52896
|
1069 (when (and (local-variable-p hook)
|
|
1070 (not (and (consp (symbol-value hook))
|
|
1071 (memq t (symbol-value hook)))))
|
|
1072 (setq local t))
|
|
1073 (let ((hook-value (if local (symbol-value hook) (default-value hook))))
|
|
1074 ;; Remove the function, for both the list and the non-list cases.
|
|
1075 (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
|
|
1076 (if (equal hook-value function) (setq hook-value nil))
|
|
1077 (setq hook-value (delete function (copy-sequence hook-value))))
|
|
1078 ;; If the function is on the global hook, we need to shadow it locally
|
|
1079 ;;(when (and local (member function (default-value hook))
|
|
1080 ;; (not (member (cons 'not function) hook-value)))
|
|
1081 ;; (push (cons 'not function) hook-value))
|
|
1082 ;; Set the actual variable
|
|
1083 (if (not local)
|
|
1084 (set-default hook hook-value)
|
|
1085 (if (equal hook-value '(t))
|
|
1086 (kill-local-variable hook)
|
|
1087 (set hook hook-value))))))
|
9510
|
1088
|
72784
|
1089 (defun add-to-list (list-var element &optional append compare-fn)
|
63797
|
1090 "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
|
72784
|
1091 The test for presence of ELEMENT is done with `equal',
|
|
1092 or with COMPARE-FN if that's non-nil.
|
32355
|
1093 If ELEMENT is added, it is added at the beginning of the list,
|
|
1094 unless the optional argument APPEND is non-nil, in which case
|
|
1095 ELEMENT is added at the end.
|
24757
|
1096
|
43833
|
1097 The return value is the new value of LIST-VAR.
|
|
1098
|
9535
|
1099 If you want to use `add-to-list' on a variable that is not defined
|
|
1100 until a certain package is loaded, you should put the call to `add-to-list'
|
|
1101 into a hook function that will be run only after loading the package.
|
|
1102 `eval-after-load' provides one way to do this. In some cases
|
|
1103 other hooks, such as major mode hooks, can do the job."
|
73465
|
1104 (if (cond
|
73466
|
1105 ((null compare-fn)
|
|
1106 (member element (symbol-value list-var)))
|
73465
|
1107 ((eq compare-fn 'eq)
|
|
1108 (memq element (symbol-value list-var)))
|
|
1109 ((eq compare-fn 'eql)
|
|
1110 (memql element (symbol-value list-var)))
|
73466
|
1111 (t
|
73555
|
1112 (let ((lst (symbol-value list-var)))
|
|
1113 (while (and lst
|
|
1114 (not (funcall compare-fn element (car lst))))
|
|
1115 (setq lst (cdr lst)))
|
|
1116 lst)))
|
21409
|
1117 (symbol-value list-var)
|
32355
|
1118 (set list-var
|
|
1119 (if append
|
|
1120 (append (symbol-value list-var) (list element))
|
|
1121 (cons element (symbol-value list-var))))))
|
39725
|
1122
|
63387
|
1123
|
|
1124 (defun add-to-ordered-list (list-var element &optional order)
|
63797
|
1125 "Add ELEMENT to the value of LIST-VAR if it isn't there yet.
|
63605
|
1126 The test for presence of ELEMENT is done with `eq'.
|
63387
|
1127
|
|
1128 The resulting list is reordered so that the elements are in the
|
63605
|
1129 order given by each element's numeric list order. Elements
|
|
1130 without a numeric list order are placed at the end of the list.
|
63387
|
1131
|
63797
|
1132 If the third optional argument ORDER is a number (integer or
|
|
1133 float), set the element's list order to the given value. If
|
|
1134 ORDER is nil or omitted, do not change the numeric order of
|
|
1135 ELEMENT. If ORDER has any other value, remove the numeric order
|
|
1136 of ELEMENT if it has one.
|
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
diff
changeset
|
1137
|
63472
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1138 The list order for each element is stored in LIST-VAR's
|
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
diff
changeset
|
1139 `list-order' property.
|
63387
|
1140
|
|
1141 The return value is the new value of LIST-VAR."
|
63472
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1142 (let ((ordering (get list-var 'list-order)))
|
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1143 (unless ordering
|
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1144 (put list-var 'list-order
|
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1145 (setq ordering (make-hash-table :weakness 'key :test 'eq))))
|
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
diff
changeset
|
1146 (when order
|
63605
|
1147 (puthash element (and (numberp order) order) ordering))
|
|
1148 (unless (memq element (symbol-value list-var))
|
|
1149 (set list-var (cons element (symbol-value list-var))))
|
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
diff
changeset
|
1150 (set list-var (sort (symbol-value list-var)
|
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
diff
changeset
|
1151 (lambda (a b)
|
63472
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1152 (let ((oa (gethash a ordering))
|
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
1153 (ob (gethash b ordering)))
|
63605
|
1154 (if (and oa ob)
|
|
1155 (< oa ob)
|
|
1156 oa)))))))
|
70415
|
1157
|
70678
|
1158 (defun add-to-history (history-var newelt &optional maxelt keep-all)
|
70415
|
1159 "Add NEWELT to the history list stored in the variable HISTORY-VAR.
|
|
1160 Return the new history list.
|
|
1161 If MAXELT is non-nil, it specifies the maximum length of the history.
|
|
1162 Otherwise, the maximum history length is the value of the `history-length'
|
|
1163 property on symbol HISTORY-VAR, if set, or the value of the `history-length'
|
|
1164 variable.
|
70678
|
1165 Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil.
|
|
1166 If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even
|
|
1167 if it is empty or a duplicate."
|
70415
|
1168 (unless maxelt
|
|
1169 (setq maxelt (or (get history-var 'history-length)
|
|
1170 history-length)))
|
|
1171 (let ((history (symbol-value history-var))
|
|
1172 tail)
|
70678
|
1173 (when (and (listp history)
|
|
1174 (or keep-all
|
|
1175 (not (stringp newelt))
|
|
1176 (> (length newelt) 0))
|
|
1177 (or keep-all
|
|
1178 (not (equal (car history) newelt))))
|
|
1179 (if history-delete-duplicates
|
|
1180 (delete newelt history))
|
|
1181 (setq history (cons newelt history))
|
|
1182 (when (integerp maxelt)
|
|
1183 (if (= 0 maxelt)
|
|
1184 (setq history nil)
|
|
1185 (setq tail (nthcdr (1- maxelt) history))
|
|
1186 (when (consp tail)
|
|
1187 (setcdr tail nil)))))
|
70415
|
1188 (set history-var history)))
|
|
1189
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1190
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1191 ;;;; Mode hooks.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1192
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1193 (defvar delay-mode-hooks nil
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1194 "If non-nil, `run-mode-hooks' should delay running the hooks.")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1195 (defvar delayed-mode-hooks nil
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1196 "List of delayed mode hooks waiting to be run.")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1197 (make-variable-buffer-local 'delayed-mode-hooks)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1198 (put 'delay-mode-hooks 'permanent-local t)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1199
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1200 (defvar after-change-major-mode-hook nil
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1201 "Normal hook run at the very end of major mode functions.")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1202
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1203 (defun run-mode-hooks (&rest hooks)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1204 "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1205 Execution is delayed if `delay-mode-hooks' is non-nil.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1206 If `delay-mode-hooks' is nil, run `after-change-major-mode-hook'
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1207 after running the mode hooks.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1208 Major mode functions should use this."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1209 (if delay-mode-hooks
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1210 ;; Delaying case.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1211 (dolist (hook hooks)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1212 (push hook delayed-mode-hooks))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1213 ;; Normal case, just run the hook as before plus any delayed hooks.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1214 (setq hooks (nconc (nreverse delayed-mode-hooks) hooks))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1215 (setq delayed-mode-hooks nil)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1216 (apply 'run-hooks hooks)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1217 (run-hooks 'after-change-major-mode-hook)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1218
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1219 (defmacro delay-mode-hooks (&rest body)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1220 "Execute BODY, but delay any `run-mode-hooks'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1221 These hooks will be executed by the first following call to
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1222 `run-mode-hooks' that occurs outside any `delayed-mode-hooks' form.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1223 Only affects hooks run in the current buffer."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1224 (declare (debug t) (indent 0))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1225 `(progn
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1226 (make-local-variable 'delay-mode-hooks)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1227 (let ((delay-mode-hooks t))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1228 ,@body)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1229
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1230 ;; PUBLIC: find if the current mode derives from another.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1231
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1232 (defun derived-mode-p (&rest modes)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1233 "Non-nil if the current major mode is derived from one of MODES.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1234 Uses the `derived-mode-parent' property of the symbol to trace backwards."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1235 (let ((parent major-mode))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1236 (while (and (not (memq parent modes))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1237 (setq parent (get parent 'derived-mode-parent))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1238 parent))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1239
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1240 ;;;; Minor modes.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1241
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1242 ;; If a minor mode is not defined with define-minor-mode,
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1243 ;; add it here explicitly.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1244 ;; isearch-mode is deliberately excluded, since you should
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1245 ;; not call it yourself.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1246 (defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1247 overwrite-mode view-mode
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1248 hs-minor-mode)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1249 "List of all minor mode functions.")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1250
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1251 (defun add-minor-mode (toggle name &optional keymap after toggle-fun)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1252 "Register a new minor mode.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1253
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1254 This is an XEmacs-compatibility function. Use `define-minor-mode' instead.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1255
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1256 TOGGLE is a symbol which is the name of a buffer-local variable that
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1257 is toggled on or off to say whether the minor mode is active or not.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1258
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1259 NAME specifies what will appear in the mode line when the minor mode
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1260 is active. NAME should be either a string starting with a space, or a
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1261 symbol whose value is such a string.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1262
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1263 Optional KEYMAP is the keymap for the minor mode that will be added
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1264 to `minor-mode-map-alist'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1265
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1266 Optional AFTER specifies that TOGGLE should be added after AFTER
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1267 in `minor-mode-alist'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1268
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1269 Optional TOGGLE-FUN is an interactive function to toggle the mode.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1270 It defaults to (and should by convention be) TOGGLE.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1271
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1272 If TOGGLE has a non-nil `:included' property, an entry for the mode is
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1273 included in the mode-line minor mode menu.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1274 If TOGGLE has a `:menu-tag', that is used for the menu item's label."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1275 (unless (memq toggle minor-mode-list)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1276 (push toggle minor-mode-list))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1277
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1278 (unless toggle-fun (setq toggle-fun toggle))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1279 (unless (eq toggle-fun toggle)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1280 (put toggle :minor-mode-function toggle-fun))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1281 ;; Add the name to the minor-mode-alist.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1282 (when name
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1283 (let ((existing (assq toggle minor-mode-alist)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1284 (if existing
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1285 (setcdr existing (list name))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1286 (let ((tail minor-mode-alist) found)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1287 (while (and tail (not found))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1288 (if (eq after (caar tail))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1289 (setq found tail)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1290 (setq tail (cdr tail))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1291 (if found
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1292 (let ((rest (cdr found)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1293 (setcdr found nil)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1294 (nconc found (list (list toggle name)) rest))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1295 (setq minor-mode-alist (cons (list toggle name)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1296 minor-mode-alist)))))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1297 ;; Add the toggle to the minor-modes menu if requested.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1298 (when (get toggle :included)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1299 (define-key mode-line-mode-menu
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1300 (vector toggle)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1301 (list 'menu-item
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1302 (concat
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1303 (or (get toggle :menu-tag)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1304 (if (stringp name) name (symbol-name toggle)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1305 (let ((mode-name (if (symbolp name) (symbol-value name))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1306 (if (and (stringp mode-name) (string-match "[^ ]+" mode-name))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1307 (concat " (" (match-string 0 mode-name) ")"))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1308 toggle-fun
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1309 :button (cons :toggle toggle))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1310
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1311 ;; Add the map to the minor-mode-map-alist.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1312 (when keymap
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1313 (let ((existing (assq toggle minor-mode-map-alist)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1314 (if existing
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1315 (setcdr existing keymap)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1316 (let ((tail minor-mode-map-alist) found)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1317 (while (and tail (not found))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1318 (if (eq after (caar tail))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1319 (setq found tail)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1320 (setq tail (cdr tail))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1321 (if found
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1322 (let ((rest (cdr found)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1323 (setcdr found nil)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1324 (nconc found (list (cons toggle keymap)) rest))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1325 (setq minor-mode-map-alist (cons (cons toggle keymap)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1326 minor-mode-map-alist))))))))
|
39725
|
1327
|
|
1328 ;;; Load history
|
|
1329
|
70267
|
1330 ;; (defvar symbol-file-load-history-loaded nil
|
|
1331 ;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'.
|
|
1332 ;; That file records the part of `load-history' for preloaded files,
|
|
1333 ;; which is cleared out before dumping to make Emacs smaller.")
|
|
1334
|
|
1335 ;; (defun load-symbol-file-load-history ()
|
|
1336 ;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done.
|
|
1337 ;; That file records the part of `load-history' for preloaded files,
|
|
1338 ;; which is cleared out before dumping to make Emacs smaller."
|
|
1339 ;; (unless symbol-file-load-history-loaded
|
|
1340 ;; (load (expand-file-name
|
|
1341 ;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem.
|
|
1342 ;; (if (eq system-type 'ms-dos)
|
|
1343 ;; "fns.el"
|
|
1344 ;; (format "fns-%s.el" emacs-version))
|
|
1345 ;; exec-directory)
|
|
1346 ;; ;; The file name fns-%s.el already has a .el extension.
|
|
1347 ;; nil nil t)
|
|
1348 ;; (setq symbol-file-load-history-loaded t)))
|
39725
|
1349
|
59124
|
1350 (defun symbol-file (symbol &optional type)
|
|
1351 "Return the input source in which SYMBOL was defined.
|
66286
|
1352 The value is an absolute file name.
|
59124
|
1353 It can also be nil, if the definition is not associated with any file.
|
|
1354
|
|
1355 If TYPE is nil, then any kind of definition is acceptable.
|
59161
|
1356 If TYPE is `defun' or `defvar', that specifies function
|
62326
|
1357 definition only or variable definition only.
|
|
1358 `defface' specifies a face definition only."
|
59124
|
1359 (if (and (or (null type) (eq type 'defun))
|
|
1360 (symbolp symbol) (fboundp symbol)
|
|
1361 (eq 'autoload (car-safe (symbol-function symbol))))
|
|
1362 (nth 1 (symbol-function symbol))
|
47355
|
1363 (let ((files load-history)
|
48474
|
1364 file)
|
47355
|
1365 (while files
|
59124
|
1366 (if (if type
|
|
1367 (if (eq type 'defvar)
|
|
1368 ;; Variables are present just as their names.
|
|
1369 (member symbol (cdr (car files)))
|
|
1370 ;; Other types are represented as (TYPE . NAME).
|
|
1371 (member (cons type symbol) (cdr (car files))))
|
|
1372 ;; We accept all types, so look for variable def
|
|
1373 ;; and then for any other kind.
|
|
1374 (or (member symbol (cdr (car files)))
|
|
1375 (rassq symbol (cdr (car files)))))
|
47355
|
1376 (setq file (car (car files)) files nil))
|
|
1377 (setq files (cdr files)))
|
|
1378 file)))
|
39725
|
1379
|
66508
|
1380 ;;;###autoload
|
|
1381 (defun locate-library (library &optional nosuffix path interactive-call)
|
|
1382 "Show the precise file name of Emacs library LIBRARY.
|
|
1383 This command searches the directories in `load-path' like `\\[load-library]'
|
|
1384 to find the file that `\\[load-library] RET LIBRARY RET' would load.
|
|
1385 Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes'
|
|
1386 to the specified name LIBRARY.
|
|
1387
|
|
1388 If the optional third arg PATH is specified, that list of directories
|
|
1389 is used instead of `load-path'.
|
|
1390
|
|
1391 When called from a program, the file name is normaly returned as a
|
|
1392 string. When run interactively, the argument INTERACTIVE-CALL is t,
|
|
1393 and the file name is displayed in the echo area."
|
|
1394 (interactive (list (completing-read "Locate library: "
|
|
1395 'locate-file-completion
|
69168
6e701396a0ec
(locate-library): Use `get-load-suffixes' instead of `load-suffixes'
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
1396 (cons load-path (get-load-suffixes)))
|
66508
|
1397 nil nil
|
|
1398 t))
|
|
1399 (let ((file (locate-file library
|
|
1400 (or path load-path)
|
69168
6e701396a0ec
(locate-library): Use `get-load-suffixes' instead of `load-suffixes'
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
1401 (append (unless nosuffix (get-load-suffixes))
|
6e701396a0ec
(locate-library): Use `get-load-suffixes' instead of `load-suffixes'
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
1402 load-file-rep-suffixes))))
|
66508
|
1403 (if interactive-call
|
|
1404 (if file
|
|
1405 (message "Library is file %s" (abbreviate-file-name file))
|
|
1406 (message "No library %s in search path" library)))
|
|
1407 file))
|
|
1408
|
114
|
1409
|
66306
|
1410 ;;;; Specifying things to do later.
|
|
1411
|
|
1412 (defmacro eval-at-startup (&rest body)
|
|
1413 "Make arrangements to evaluate BODY when Emacs starts up.
|
|
1414 If this is run after Emacs startup, evaluate BODY immediately.
|
|
1415 Always returns nil.
|
|
1416
|
|
1417 This works by adding a function to `before-init-hook'.
|
|
1418 That function's doc string says which file created it."
|
|
1419 `(progn
|
|
1420 (if command-line-processed
|
|
1421 (progn . ,body)
|
|
1422 (add-hook 'before-init-hook
|
|
1423 '(lambda () ,(concat "From " (or load-file-name "no file"))
|
|
1424 . ,body)
|
|
1425 t))
|
|
1426 nil))
|
2504
|
1427
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1428 (defun load-history-regexp (file)
|
71037
|
1429 "Form a regexp to find FILE in `load-history'.
|
|
1430 FILE, a string, is described in the function `eval-after-load'."
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1431 (if (file-name-absolute-p file)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1432 (setq file (file-truename file)))
|
71037
|
1433 (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)")
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1434 (regexp-quote file)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1435 (if (file-name-extension file)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1436 ""
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1437 ;; Note: regexp-opt can't be used here, since we need to call
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1438 ;; this before Emacs has been fully started. 2006-05-21
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1439 (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?"))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1440 "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|")
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1441 "\\)?\\'"))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1442
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1443 (defun load-history-filename-element (file-regexp)
|
71037
|
1444 "Get the first elt of `load-history' whose car matches FILE-REGEXP.
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1445 Return nil if there isn't one."
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1446 (let* ((loads load-history)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1447 (load-elt (and loads (car loads))))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1448 (save-match-data
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1449 (while (and loads
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1450 (or (null (car load-elt))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1451 (not (string-match file-regexp (car load-elt)))))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1452 (setq loads (cdr loads)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1453 load-elt (and loads (car loads)))))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1454 load-elt))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1455
|
2504
|
1456 (defun eval-after-load (file form)
|
|
1457 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
|
10794
|
1458 If FILE is already loaded, evaluate FORM right now.
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1459
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1460 If a matching file is loaded again, FORM will be evaluated again.
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1461
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1462 If FILE is a string, it may be either an absolute or a relative file
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1463 name, and may have an extension \(e.g. \".el\") or may lack one, and
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1464 additionally may or may not have an extension denoting a compressed
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1465 format \(e.g. \".gz\").
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1466
|
71037
|
1467 When FILE is absolute, this first converts it to a true name by chasing
|
|
1468 symbolic links. Only a file of this name \(see next paragraph regarding
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1469 extensions) will trigger the evaluation of FORM. When FILE is relative,
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1470 a file whose absolute true name ends in FILE will trigger evaluation.
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1471
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1472 When FILE lacks an extension, a file name with any extension will trigger
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1473 evaluation. Otherwise, its extension must match FILE's. A further
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1474 extension for a compressed format \(e.g. \".gz\") on FILE will not affect
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1475 this name matching.
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1476
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1477 Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1478 is evaluated whenever that feature is `provide'd.
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1479
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1480 Usually FILE is just a library name like \"font-lock\" or a feature name
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1481 like 'font-lock.
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1482
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1483 This function makes or adds to an entry on `after-load-alist'."
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1484 ;; Add this FORM into after-load-alist (regardless of whether we'll be
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1485 ;; evaluating it now).
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1486 (let* ((regexp-or-feature
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1487 (if (stringp file) (load-history-regexp file) file))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1488 (elt (assoc regexp-or-feature after-load-alist)))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1489 (unless elt
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1490 (setq elt (list regexp-or-feature))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1491 (push elt after-load-alist))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1492 ;; Add FORM to the element unless it's already there.
|
41140
|
1493 (unless (member form (cdr elt))
|
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1494 (nconc elt (list form)))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1495
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1496 ;; Is there an already loaded file whose name (or `provide' name)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1497 ;; matches FILE?
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1498 (if (if (stringp file)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1499 (load-history-filename-element regexp-or-feature)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1500 (featurep file))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1501 (eval form))))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1502
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1503 (defun do-after-load-evaluation (abs-file)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1504 "Evaluate all `eval-after-load' forms, if any, for ABS-FILE.
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1505 ABS-FILE, a string, should be the absolute true name of a file just loaded."
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1506 (let ((after-load-elts after-load-alist)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1507 a-l-element file-elements file-element form)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1508 (while after-load-elts
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1509 (setq a-l-element (car after-load-elts)
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1510 after-load-elts (cdr after-load-elts))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1511 (when (and (stringp (car a-l-element))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1512 (string-match (car a-l-element) abs-file))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1513 (while (setq a-l-element (cdr a-l-element)) ; discard the file name
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1514 (setq form (car a-l-element))
|
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
diff
changeset
|
1515 (eval form))))))
|
2504
|
1516
|
|
1517 (defun eval-next-after-load (file)
|
|
1518 "Read the following input sexp, and run it whenever FILE is loaded.
|
|
1519 This makes or adds to an entry on `after-load-alist'.
|
|
1520 FILE should be the name of a library, with no directory name."
|
|
1521 (eval-after-load file (read)))
|
45587
|
1522
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1523 ;;;; Process stuff.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1524
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1525 ;; open-network-stream is a wrapper around make-network-process.
|
45587
|
1526
|
62372
|
1527 (when (featurep 'make-network-process)
|
|
1528 (defun open-network-stream (name buffer host service)
|
45587
|
1529 "Open a TCP connection for a service to a host.
|
|
1530 Returns a subprocess-object to represent the connection.
|
|
1531 Input and output work as for subprocesses; `delete-process' closes it.
|
55406
|
1532
|
45587
|
1533 Args are NAME BUFFER HOST SERVICE.
|
|
1534 NAME is name for process. It is modified if necessary to make it unique.
|
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1535 BUFFER is the buffer (or buffer name) to associate with the process.
|
45587
|
1536 Process output goes at end of that buffer, unless you specify
|
|
1537 an output stream or filter function to handle the output.
|
|
1538 BUFFER may be also nil, meaning that this process is not associated
|
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1539 with any buffer.
|
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1540 HOST is name of the host to connect to, or its IP address.
|
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1541 SERVICE is name of the service desired, or an integer specifying
|
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1542 a port number to connect to."
|
45587
|
1543 (make-network-process :name name :buffer buffer
|
62372
|
1544 :host host :service service)))
|
45587
|
1545
|
|
1546 ;; compatibility
|
|
1547
|
55406
|
1548 (make-obsolete 'process-kill-without-query
|
55884
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1549 "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'."
|
59996
|
1550 "22.1")
|
45587
|
1551 (defun process-kill-without-query (process &optional flag)
|
|
1552 "Say no query needed if PROCESS is running when Emacs is exited.
|
|
1553 Optional second argument if non-nil says to require a query.
|
55406
|
1554 Value is t if a query was formerly required."
|
45587
|
1555 (let ((old (process-query-on-exit-flag process)))
|
|
1556 (set-process-query-on-exit-flag process nil)
|
|
1557 old))
|
2504
|
1558
|
49225
|
1559 ;; process plist management
|
|
1560
|
|
1561 (defun process-get (process propname)
|
|
1562 "Return the value of PROCESS' PROPNAME property.
|
|
1563 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
|
|
1564 (plist-get (process-plist process) propname))
|
|
1565
|
|
1566 (defun process-put (process propname value)
|
|
1567 "Change PROCESS' PROPNAME property to VALUE.
|
|
1568 It can be retrieved with `(process-get PROCESS PROPNAME)'."
|
49597
|
1569 (set-process-plist process
|
49225
|
1570 (plist-put (process-plist process) propname value)))
|
|
1571
|
2504
|
1572
|
|
1573 ;;;; Input and display facilities.
|
|
1574
|
18880
|
1575 (defvar read-quoted-char-radix 8
|
18828
|
1576 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
|
18880
|
1577 Legitimate radix values are 8, 10 and 16.")
|
|
1578
|
|
1579 (custom-declare-variable-early
|
47916
|
1580 'read-quoted-char-radix 8
|
18880
|
1581 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'.
|
18828
|
1582 Legitimate radix values are 8, 10 and 16."
|
|
1583 :type '(choice (const 8) (const 10) (const 16))
|
|
1584 :group 'editing-basics)
|
|
1585
|
2504
|
1586 (defun read-quoted-char (&optional prompt)
|
18821
|
1587 "Like `read-char', but do not allow quitting.
|
|
1588 Also, if the first character read is an octal digit,
|
|
1589 we read any number of octal digits and return the
|
21008
|
1590 specified character code. Any nondigit terminates the sequence.
|
18828
|
1591 If the terminator is RET, it is discarded;
|
18821
|
1592 any other terminator is used itself as input.
|
|
1593
|
21008
|
1594 The optional argument PROMPT specifies a string to use to prompt the user.
|
|
1595 The variable `read-quoted-char-radix' controls which radix to use
|
|
1596 for numeric input."
|
50427
|
1597 (let ((message-log-max nil) done (first t) (code 0) char translated)
|
18821
|
1598 (while (not done)
|
|
1599 (let ((inhibit-quit first)
|
12108
|
1600 ;; Don't let C-h get the help message--only help function keys.
|
|
1601 (help-char nil)
|
|
1602 (help-form
|
|
1603 "Type the special character you want to use,
|
18821
|
1604 or the octal character code.
|
18828
|
1605 RET terminates the character code and is discarded;
|
18821
|
1606 any other non-digit terminates the character code and is then used as input."))
|
47747
|
1607 (setq char (read-event (and prompt (format "%s-" prompt)) t))
|
2504
|
1608 (if inhibit-quit (setq quit-flag nil)))
|
47747
|
1609 ;; Translate TAB key into control-I ASCII character, and so on.
|
|
1610 ;; Note: `read-char' does it using the `ascii-character' property.
|
|
1611 ;; We could try and use read-key-sequence instead, but then C-q ESC
|
|
1612 ;; or C-q C-x might not return immediately since ESC or C-x might be
|
|
1613 ;; bound to some prefix in function-key-map or key-translation-map.
|
50427
|
1614 (setq translated char)
|
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
diff
changeset
|
1615 (let ((translation (lookup-key local-function-key-map (vector char))))
|
50427
|
1616 (if (arrayp translation)
|
|
1617 (setq translated (aref translation 0))))
|
|
1618 (cond ((null translated))
|
|
1619 ((not (integerp translated))
|
|
1620 (setq unread-command-events (list char)
|
18828
|
1621 done t))
|
50427
|
1622 ((/= (logand translated ?\M-\^@) 0)
|
19175
|
1623 ;; Turn a meta-character into a character with the 0200 bit set.
|
50427
|
1624 (setq code (logior (logand translated (lognot ?\M-\^@)) 128)
|
19175
|
1625 done t))
|
50427
|
1626 ((and (<= ?0 translated) (< translated (+ ?0 (min 10 read-quoted-char-radix))))
|
|
1627 (setq code (+ (* code read-quoted-char-radix) (- translated ?0)))
|
|
1628 (and prompt (setq prompt (message "%s %c" prompt translated))))
|
|
1629 ((and (<= ?a (downcase translated))
|
51051
|
1630 (< (downcase translated) (+ ?a -10 (min 36 read-quoted-char-radix))))
|
19002
|
1631 (setq code (+ (* code read-quoted-char-radix)
|
50427
|
1632 (+ 10 (- (downcase translated) ?a))))
|
|
1633 (and prompt (setq prompt (message "%s %c" prompt translated))))
|
|
1634 ((and (not first) (eq translated ?\C-m))
|
18821
|
1635 (setq done t))
|
|
1636 ((not first)
|
50427
|
1637 (setq unread-command-events (list char)
|
18821
|
1638 done t))
|
50427
|
1639 (t (setq code translated
|
18821
|
1640 done t)))
|
|
1641 (setq first nil))
|
19175
|
1642 code))
|
2504
|
1643
|
57789
|
1644 (defun read-passwd (prompt &optional confirm default)
|
|
1645 "Read a password, prompting with PROMPT, and return it.
|
|
1646 If optional CONFIRM is non-nil, read the password twice to make sure.
|
|
1647 Optional DEFAULT is a default password to use instead of empty input.
|
|
1648
|
|
1649 This function echoes `.' for each character that the user types.
|
|
1650 The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line.
|
|
1651 C-g quits; if `inhibit-quit' was non-nil around this function,
|
70901
|
1652 then it returns nil if the user types C-g, but quit-flag remains set.
|
57789
|
1653
|
|
1654 Once the caller uses the password, it can erase the password
|
|
1655 by doing (clear-string STRING)."
|
|
1656 (with-local-quit
|
|
1657 (if confirm
|
|
1658 (let (success)
|
|
1659 (while (not success)
|
|
1660 (let ((first (read-passwd prompt nil default))
|
|
1661 (second (read-passwd "Confirm password: " nil default)))
|
|
1662 (if (equal first second)
|
|
1663 (progn
|
|
1664 (and (arrayp second) (clear-string second))
|
|
1665 (setq success first))
|
|
1666 (and (arrayp first) (clear-string first))
|
|
1667 (and (arrayp second) (clear-string second))
|
|
1668 (message "Password not repeated accurately; please start over")
|
|
1669 (sit-for 1))))
|
|
1670 success)
|
|
1671 (let ((pass nil)
|
70897
|
1672 ;; Copy it so that add-text-properties won't modify
|
|
1673 ;; the object that was passed in by the caller.
|
|
1674 (prompt (copy-sequence prompt))
|
57789
|
1675 (c 0)
|
|
1676 (echo-keystrokes 0)
|
69978
|
1677 (cursor-in-echo-area t)
|
|
1678 (message-log-max nil))
|
67012
|
1679 (add-text-properties 0 (length prompt)
|
|
1680 minibuffer-prompt-properties prompt)
|
57789
|
1681 (while (progn (message "%s%s"
|
|
1682 prompt
|
|
1683 (make-string (length pass) ?.))
|
|
1684 (setq c (read-char-exclusive nil t))
|
|
1685 (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
|
|
1686 (clear-this-command-keys)
|
|
1687 (if (= c ?\C-u)
|
|
1688 (progn
|
|
1689 (and (arrayp pass) (clear-string pass))
|
|
1690 (setq pass ""))
|
|
1691 (if (and (/= c ?\b) (/= c ?\177))
|
|
1692 (let* ((new-char (char-to-string c))
|
|
1693 (new-pass (concat pass new-char)))
|
|
1694 (and (arrayp pass) (clear-string pass))
|
|
1695 (clear-string new-char)
|
|
1696 (setq c ?\0)
|
|
1697 (setq pass new-pass))
|
|
1698 (if (> (length pass) 0)
|
|
1699 (let ((new-pass (substring pass 0 -1)))
|
|
1700 (and (arrayp pass) (clear-string pass))
|
|
1701 (setq pass new-pass))))))
|
|
1702 (message nil)
|
|
1703 (or pass default "")))))
|
|
1704
|
54570
|
1705 ;; This should be used by `call-interactively' for `n' specs.
|
|
1706 (defun read-number (prompt &optional default)
|
|
1707 (let ((n nil))
|
|
1708 (when default
|
|
1709 (setq prompt
|
55891
|
1710 (if (string-match "\\(\\):[ \t]*\\'" prompt)
|
|
1711 (replace-match (format " (default %s)" default) t t prompt 1)
|
|
1712 (replace-regexp-in-string "[ \t]*\\'"
|
|
1713 (format " (default %s) " default)
|
55976
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1714 prompt t t))))
|
54570
|
1715 (while
|
|
1716 (progn
|
|
1717 (let ((str (read-from-minibuffer prompt nil nil nil nil
|
55008
|
1718 (and default
|
|
1719 (number-to-string default)))))
|
54570
|
1720 (setq n (cond
|
|
1721 ((zerop (length str)) default)
|
|
1722 ((stringp str) (read str)))))
|
|
1723 (unless (numberp n)
|
|
1724 (message "Please enter a number.")
|
|
1725 (sit-for 1)
|
|
1726 t)))
|
|
1727 n))
|
71763
|
1728
|
|
1729 (defun sit-for (seconds &optional nodisp obsolete)
|
|
1730 "Perform redisplay, then wait for SECONDS seconds or until input is available.
|
|
1731 SECONDS may be a floating-point value.
|
|
1732 \(On operating systems that do not support waiting for fractions of a
|
|
1733 second, floating-point values are rounded down to the nearest integer.)
|
|
1734
|
|
1735 If optional arg NODISP is t, don't redisplay, just wait for input.
|
|
1736 Redisplay does not happen if input is available before it starts.
|
|
1737
|
|
1738 Value is t if waited the full time with no input arriving, and nil otherwise.
|
|
1739
|
71775
|
1740 An obsolete, but still supported form is
|
71763
|
1741 \(sit-for SECONDS &optional MILLISECONDS NODISP)
|
71775
|
1742 where the optional arg MILLISECONDS specifies an additional wait period,
|
71763
|
1743 in milliseconds; this was useful when Emacs was built without
|
71775
|
1744 floating point support.
|
|
1745
|
|
1746 \(fn SECONDS &optional NODISP)"
|
72817
|
1747 (when (or obsolete (numberp nodisp))
|
|
1748 (setq seconds (+ seconds (* 1e-3 nodisp)))
|
|
1749 (setq nodisp obsolete))
|
|
1750 (cond
|
|
1751 (noninteractive
|
|
1752 (sleep-for seconds)
|
|
1753 t)
|
|
1754 ((input-pending-p)
|
|
1755 nil)
|
|
1756 ((<= seconds 0)
|
|
1757 (or nodisp (redisplay)))
|
|
1758 (t
|
|
1759 (or nodisp (redisplay))
|
|
1760 (let ((read (read-event nil nil seconds)))
|
|
1761 (or (null read)
|
73465
|
1762 (progn
|
|
1763 ;; If last command was a prefix arg, e.g. C-u, push this event onto
|
|
1764 ;; unread-command-events as (t . EVENT) so it will be added to
|
|
1765 ;; this-command-keys by read-key-sequence.
|
|
1766 (if (eq overriding-terminal-local-map universal-argument-map)
|
|
1767 (setq read (cons t read)))
|
|
1768 (push read unread-command-events)
|
|
1769 nil))))))
|
20472
|
1770
|
44668
|
1771 ;;; Atomic change groups.
|
|
1772
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1773 (defmacro atomic-change-group (&rest body)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1774 "Perform BODY as an atomic change group.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1775 This means that if BODY exits abnormally,
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1776 all of its changes to the current buffer are undone.
|
46783
|
1777 This works regardless of whether undo is enabled in the buffer.
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1778
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1779 This mechanism is transparent to ordinary use of undo;
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1780 if undo is enabled in the buffer and BODY succeeds, the
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1781 user can undo the change normally."
|
67274
|
1782 (declare (indent 0) (debug t))
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1783 (let ((handle (make-symbol "--change-group-handle--"))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1784 (success (make-symbol "--change-group-success--")))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1785 `(let ((,handle (prepare-change-group))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1786 (,success nil))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1787 (unwind-protect
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1788 (progn
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1789 ;; This is inside the unwind-protect because
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1790 ;; it enables undo if that was disabled; we need
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1791 ;; to make sure that it gets disabled again.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1792 (activate-change-group ,handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1793 ,@body
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1794 (setq ,success t))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1795 ;; Either of these functions will disable undo
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1796 ;; if it was disabled before.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1797 (if ,success
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1798 (accept-change-group ,handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1799 (cancel-change-group ,handle))))))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1800
|
51068
|
1801 (defun prepare-change-group (&optional buffer)
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1802 "Return a handle for the current buffer's state, for a change group.
|
51068
|
1803 If you specify BUFFER, make a handle for BUFFER's state instead.
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1804
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1805 Pass the handle to `activate-change-group' afterward to initiate
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1806 the actual changes of the change group.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1807
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1808 To finish the change group, call either `accept-change-group' or
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1809 `cancel-change-group' passing the same handle as argument. Call
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1810 `accept-change-group' to accept the changes in the group as final;
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1811 call `cancel-change-group' to undo them all. You should use
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1812 `unwind-protect' to make sure the group is always finished. The call
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1813 to `activate-change-group' should be inside the `unwind-protect'.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1814 Once you finish the group, don't use the handle again--don't try to
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1815 finish the same group twice. For a simple example of correct use, see
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1816 the source code of `atomic-change-group'.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1817
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1818 The handle records only the specified buffer. To make a multibuffer
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1819 change group, call this function once for each buffer you want to
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1820 cover, then use `nconc' to combine the returned values, like this:
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1821
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1822 (nconc (prepare-change-group buffer-1)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1823 (prepare-change-group buffer-2))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1824
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1825 You can then activate that multibuffer change group with a single
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1826 call to `activate-change-group' and finish it with a single call
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1827 to `accept-change-group' or `cancel-change-group'."
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1828
|
51068
|
1829 (if buffer
|
|
1830 (list (cons buffer (with-current-buffer buffer buffer-undo-list)))
|
|
1831 (list (cons (current-buffer) buffer-undo-list))))
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1832
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1833 (defun activate-change-group (handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1834 "Activate a change group made with `prepare-change-group' (which see)."
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1835 (dolist (elt handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1836 (with-current-buffer (car elt)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1837 (if (eq buffer-undo-list t)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1838 (setq buffer-undo-list nil)))))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1839
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1840 (defun accept-change-group (handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1841 "Finish a change group made with `prepare-change-group' (which see).
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1842 This finishes the change group by accepting its changes as final."
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1843 (dolist (elt handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1844 (with-current-buffer (car elt)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1845 (if (eq elt t)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1846 (setq buffer-undo-list t)))))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1847
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1848 (defun cancel-change-group (handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1849 "Finish a change group made with `prepare-change-group' (which see).
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1850 This finishes the change group by reverting all of its changes."
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1851 (dolist (elt handle)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1852 (with-current-buffer (car elt)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1853 (setq elt (cdr elt))
|
47916
|
1854 (let ((old-car
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1855 (if (consp elt) (car elt)))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1856 (old-cdr
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1857 (if (consp elt) (cdr elt))))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1858 ;; Temporarily truncate the undo log at ELT.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1859 (when (consp elt)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1860 (setcar elt nil) (setcdr elt nil))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1861 (unless (eq last-command 'undo) (undo-start))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1862 ;; Make sure there's no confusion.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1863 (when (and (consp elt) (not (eq elt (last pending-undo-list))))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1864 (error "Undoing to some unrelated state"))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1865 ;; Undo it all.
|
67917
|
1866 (while (listp pending-undo-list) (undo-more 1))
|
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1867 ;; Reset the modified cons cell ELT to its original content.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1868 (when (consp elt)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1869 (setcar elt old-car)
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1870 (setcdr elt old-cdr))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1871 ;; Revert the undo info to what it was when we grabbed the state.
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1872 (setq buffer-undo-list elt)))))
|
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1873
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1874 ;;;; Display-related functions.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
1875
|
44285
|
1876 ;; For compatibility.
|
|
1877 (defalias 'redraw-modeline 'force-mode-line-update)
|
|
1878
|
2504
|
1879 (defun force-mode-line-update (&optional all)
|
52858
|
1880 "Force redisplay of the current buffer's mode line and header line.
|
|
1881 With optional non-nil ALL, force redisplay of all mode lines and
|
|
1882 header lines. This function also forces recomputation of the
|
|
1883 menu bar menus and the frame title."
|
2504
|
1884 (if all (save-excursion (set-buffer (other-buffer))))
|
|
1885 (set-buffer-modified-p (buffer-modified-p)))
|
|
1886
|
41618
|
1887 (defun momentary-string-display (string pos &optional exit-char message)
|
114
|
1888 "Momentarily display STRING in the buffer at POS.
|
55187
|
1889 Display remains until next event is input.
|
75063
394073868e11
(momentary-string-display): After moving point, set POS variable to it to avoid
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
1890 If POS is a marker, only its position is used; its buffer is ignored.
|
55187
|
1891 Optional third arg EXIT-CHAR can be a character, event or event
|
|
1892 description list. EXIT-CHAR defaults to SPC. If the input is
|
|
1893 EXIT-CHAR it is swallowed; otherwise it is then available as
|
|
1894 input (as a command if nothing else).
|
114
|
1895 Display MESSAGE (optional fourth arg) in the echo area.
|
|
1896 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
|
74242
|
1897 (or exit-char (setq exit-char ?\s))
|
75088
|
1898 (let ((momentary-overlay (make-overlay pos pos nil t)))
|
|
1899 (overlay-put momentary-overlay 'before-string
|
|
1900 (propertize string 'face 'momentary))
|
114
|
1901 (unwind-protect
|
|
1902 (progn
|
75088
|
1903 ;; If the message end is off screen, recenter now.
|
|
1904 (if (< (window-end nil t) (+ pos (length string)))
|
|
1905 (recenter (/ (window-height) 2)))
|
|
1906 ;; If that pushed message start off the screen,
|
|
1907 ;; scroll to start it at the top of the screen.
|
75175
|
1908 (save-excursion
|
|
1909 (move-to-window-line 0)
|
|
1910 (if (> (point) pos)
|
75088
|
1911 (goto-char pos)
|
75175
|
1912 (recenter 0)))
|
114
|
1913 (message (or message "Type %s to continue editing.")
|
|
1914 (single-key-description exit-char))
|
55187
|
1915 (let (char)
|
|
1916 (if (integerp exit-char)
|
|
1917 (condition-case nil
|
|
1918 (progn
|
|
1919 (setq char (read-char))
|
|
1920 (or (eq char exit-char)
|
|
1921 (setq unread-command-events (list char))))
|
|
1922 (error
|
|
1923 ;; `exit-char' is a character, hence it differs
|
|
1924 ;; from char, which is an event.
|
|
1925 (setq unread-command-events (list char))))
|
|
1926 ;; `exit-char' can be an event, or an event description
|
|
1927 ;; list.
|
|
1928 (setq char (read-event))
|
|
1929 (or (eq char exit-char)
|
|
1930 (eq char (event-convert-list exit-char))
|
|
1931 (setq unread-command-events (list char))))))
|
75088
|
1932 (delete-overlay momentary-overlay))))
|
114
|
1933
|
2504
|
1934
|
41618
|
1935 ;;;; Overlay operations
|
|
1936
|
|
1937 (defun copy-overlay (o)
|
|
1938 "Return a copy of overlay O."
|
|
1939 (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
|
|
1940 ;; FIXME: there's no easy way to find the
|
|
1941 ;; insertion-type of the two markers.
|
|
1942 (overlay-buffer o)))
|
|
1943 (props (overlay-properties o)))
|
|
1944 (while props
|
|
1945 (overlay-put o1 (pop props) (pop props)))
|
|
1946 o1))
|
|
1947
|
55202
|
1948 (defun remove-overlays (&optional beg end name val)
|
41618
|
1949 "Clear BEG and END of overlays whose property NAME has value VAL.
|
55477
|
1950 Overlays might be moved and/or split.
|
|
1951 BEG and END default respectively to the beginning and end of buffer."
|
73829
|
1952 ;; This speeds up the loops over overlays.
|
55202
|
1953 (unless beg (setq beg (point-min)))
|
|
1954 (unless end (setq end (point-max)))
|
73943
|
1955 (overlay-recenter end)
|
41618
|
1956 (if (< end beg)
|
|
1957 (setq beg (prog1 end (setq end beg))))
|
|
1958 (save-excursion
|
|
1959 (dolist (o (overlays-in beg end))
|
|
1960 (when (eq (overlay-get o name) val)
|
|
1961 ;; Either push this overlay outside beg...end
|
|
1962 ;; or split it to exclude beg...end
|
|
1963 ;; or delete it entirely (if it is contained in beg...end).
|
|
1964 (if (< (overlay-start o) beg)
|
|
1965 (if (> (overlay-end o) end)
|
|
1966 (progn
|
|
1967 (move-overlay (copy-overlay o)
|
|
1968 (overlay-start o) beg)
|
|
1969 (move-overlay o end (overlay-end o)))
|
|
1970 (move-overlay o (overlay-start o) beg))
|
|
1971 (if (> (overlay-end o) end)
|
|
1972 (move-overlay o end (overlay-end o))
|
|
1973 (delete-overlay o)))))))
|
42917
|
1974
|
2504
|
1975 ;;;; Miscellanea.
|
|
1976
|
20846
|
1977 (defvar suspend-hook nil
|
|
1978 "Normal hook run by `suspend-emacs', before suspending.")
|
|
1979
|
|
1980 (defvar suspend-resume-hook nil
|
|
1981 "Normal hook run by `suspend-emacs', after Emacs is continued.")
|
|
1982
|
42083
|
1983 (defvar temp-buffer-show-hook nil
|
|
1984 "Normal hook run by `with-output-to-temp-buffer' after displaying the buffer.
|
|
1985 When the hook runs, the temporary buffer is current, and the window it
|
|
1986 was displayed in is selected. This hook is normally set up with a
|
|
1987 function to make the buffer read only, and find function names and
|
|
1988 variable names in it, provided the major mode is still Help mode.")
|
|
1989
|
|
1990 (defvar temp-buffer-setup-hook nil
|
|
1991 "Normal hook run by `with-output-to-temp-buffer' at the start.
|
|
1992 When the hook runs, the temporary buffer is current.
|
|
1993 This hook is normally set up with a function to put the buffer in Help
|
|
1994 mode.")
|
|
1995
|
10254
|
1996 ;; Avoid compiler warnings about this variable,
|
|
1997 ;; which has a special meaning on certain system types.
|
|
1998 (defvar buffer-file-type nil
|
|
1999 "Non-nil if the visited file is a binary file.
|
|
2000 This variable is meaningful on MS-DOG and Windows NT.
|
|
2001 On those systems, it is automatically local in every buffer.
|
|
2002 On other systems, this variable is normally always nil.")
|
68492
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
2003
|
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
2004 ;; The `assert' macro from the cl package signals
|
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
2005 ;; `cl-assertion-failed' at runtime so always define it.
|
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
2006 (put 'cl-assertion-failed 'error-conditions '(error))
|
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
2007 (put 'cl-assertion-failed 'error-message "Assertion failed")
|
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
diff
changeset
|
2008
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2009
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2010 ;;;; Misc. useful functions.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2011
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2012 (defun find-tag-default ()
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2013 "Determine default tag to search for, based on text at point.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2014 If there is no plausible default, return nil."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2015 (save-excursion
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2016 (while (looking-at "\\sw\\|\\s_")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2017 (forward-char 1))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2018 (if (or (re-search-backward "\\sw\\|\\s_"
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2019 (save-excursion (beginning-of-line) (point))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2020 t)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2021 (re-search-forward "\\(\\sw\\|\\s_\\)+"
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2022 (save-excursion (end-of-line) (point))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2023 t))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2024 (progn
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2025 (goto-char (match-end 0))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2026 (condition-case nil
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2027 (buffer-substring-no-properties
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2028 (point)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2029 (progn (forward-sexp -1)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2030 (while (looking-at "\\s'")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2031 (forward-char 1))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2032 (point)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2033 (error nil)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2034 nil)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2035
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2036 (defun play-sound (sound)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2037 "SOUND is a list of the form `(sound KEYWORD VALUE...)'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2038 The following keywords are recognized:
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2039
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2040 :file FILE - read sound data from FILE. If FILE isn't an
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2041 absolute file name, it is searched in `data-directory'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2042
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2043 :data DATA - read sound data from string DATA.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2044
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2045 Exactly one of :file or :data must be present.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2046
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2047 :volume VOL - set volume to VOL. VOL must an integer in the
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2048 range 0..100 or a float in the range 0..1.0. If not specified,
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2049 don't change the volume setting of the sound device.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2050
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2051 :device DEVICE - play sound on DEVICE. If not specified,
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2052 a system-dependent default device name is used."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2053 (if (fboundp 'play-sound-internal)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2054 (play-sound-internal sound)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2055 (error "This Emacs binary lacks sound support")))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2056
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2057 (defun shell-quote-argument (argument)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2058 "Quote an argument for passing as argument to an inferior shell."
|
73125
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2059 (if (or (eq system-type 'ms-dos)
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2060 (and (eq system-type 'windows-nt) (w32-shell-dos-semantics)))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2061 ;; Quote using double quotes, but escape any existing quotes in
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2062 ;; the argument with backslashes.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2063 (let ((result "")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2064 (start 0)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2065 end)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2066 (if (or (null (string-match "[^\"]" argument))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2067 (< (match-end 0) (length argument)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2068 (while (string-match "[\"]" argument start)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2069 (setq end (match-beginning 0)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2070 result (concat result (substring argument start end)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2071 "\\" (substring argument end (1+ end)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2072 start (1+ end))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2073 (concat "\"" result (substring argument start) "\""))
|
73125
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2074 (if (equal argument "")
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2075 "''"
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2076 ;; Quote everything except POSIX filename characters.
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2077 ;; This should be safe enough even for really weird shells.
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2078 (let ((result "") (start 0) end)
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2079 (while (string-match "[^-0-9a-zA-Z_./]" argument start)
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2080 (setq end (match-beginning 0)
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2081 result (concat result (substring argument start end)
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2082 "\\" (substring argument end (1+ end)))
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2083 start (1+ end)))
|
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
diff
changeset
|
2084 (concat result (substring argument start))))))
|
69830
|
2085
|
|
2086 (defun string-or-null-p (object)
|
|
2087 "Return t if OBJECT is a string or nil.
|
|
2088 Otherwise, return nil."
|
|
2089 (or (stringp object) (null object)))
|
|
2090
|
70267
|
2091 (defun booleanp (object)
|
|
2092 "Return non-nil if OBJECT is one of the two canonical boolean values: t or nil."
|
|
2093 (memq object '(nil t)))
|
|
2094
|
70552
|
2095 (defun field-at-pos (pos)
|
70547
|
2096 "Return the field at position POS, taking stickiness etc into account"
|
|
2097 (let ((raw-field (get-char-property (field-beginning pos) 'field)))
|
|
2098 (if (eq raw-field 'boundary)
|
|
2099 (get-char-property (1- (field-end pos)) 'field)
|
|
2100 raw-field)))
|
|
2101
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2102
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2103 ;;;; Support for yanking and text properties.
|
2504
|
2104
|
44668
|
2105 (defvar yank-excluded-properties)
|
|
2106
|
44980
|
2107 (defun remove-yank-excluded-properties (start end)
|
|
2108 "Remove `yank-excluded-properties' between START and END positions.
|
|
2109 Replaces `category' properties with their defined properties."
|
|
2110 (let ((inhibit-read-only t))
|
|
2111 ;; Replace any `category' property with the properties it stands for.
|
|
2112 (unless (memq yank-excluded-properties '(t nil))
|
|
2113 (save-excursion
|
|
2114 (goto-char start)
|
|
2115 (while (< (point) end)
|
|
2116 (let ((cat (get-text-property (point) 'category))
|
|
2117 run-end)
|
|
2118 (setq run-end
|
|
2119 (next-single-property-change (point) 'category nil end))
|
47675
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2120 (when cat
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2121 (let (run-end2 original)
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2122 (remove-list-of-text-properties (point) run-end '(category))
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2123 (while (< (point) run-end)
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2124 (setq run-end2 (next-property-change (point) nil run-end))
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2125 (setq original (text-properties-at (point)))
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2126 (set-text-properties (point) run-end2 (symbol-plist cat))
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2127 (add-text-properties (point) run-end2 original)
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2128 (goto-char run-end2))))
|
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2129 (goto-char run-end)))))
|
44980
|
2130 (if (eq yank-excluded-properties t)
|
|
2131 (set-text-properties start end nil)
|
47675
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2132 (remove-list-of-text-properties start end yank-excluded-properties))))
|
44980
|
2133
|
49310
|
2134 (defvar yank-undo-function)
|
|
2135
|
|
2136 (defun insert-for-yank (string)
|
53368
|
2137 "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment.
|
|
2138
|
|
2139 See `insert-for-yank-1' for more details."
|
|
2140 (let (to)
|
|
2141 (while (setq to (next-single-property-change 0 'yank-handler string))
|
|
2142 (insert-for-yank-1 (substring string 0 to))
|
|
2143 (setq string (substring string to))))
|
|
2144 (insert-for-yank-1 string))
|
|
2145
|
|
2146 (defun insert-for-yank-1 (string)
|
49310
|
2147 "Insert STRING at point, stripping some text properties.
|
53368
|
2148
|
49310
|
2149 Strip text properties from the inserted text according to
|
|
2150 `yank-excluded-properties'. Otherwise just like (insert STRING).
|
44723
|
2151
|
49363
|
2152 If STRING has a non-nil `yank-handler' property on the first character,
|
63258
|
2153 the normal insert behavior is modified in various ways. The value of
|
65014
|
2154 the yank-handler property must be a list with one to four elements
|
49492
|
2155 with the following format: (FUNCTION PARAM NOEXCLUDE UNDO).
|
49310
|
2156 When FUNCTION is present and non-nil, it is called instead of `insert'
|
|
2157 to insert the string. FUNCTION takes one argument--the object to insert.
|
|
2158 If PARAM is present and non-nil, it replaces STRING as the object
|
|
2159 passed to FUNCTION (or `insert'); for example, if FUNCTION is
|
|
2160 `yank-rectangle', PARAM may be a list of strings to insert as a
|
|
2161 rectangle.
|
|
2162 If NOEXCLUDE is present and non-nil, the normal removal of the
|
|
2163 yank-excluded-properties is not performed; instead FUNCTION is
|
|
2164 responsible for removing those properties. This may be necessary
|
|
2165 if FUNCTION adjusts point before or after inserting the object.
|
|
2166 If UNDO is present and non-nil, it is a function that will be called
|
|
2167 by `yank-pop' to undo the insertion of the current object. It is
|
49597
|
2168 called with two arguments, the start and end of the current region.
|
49492
|
2169 FUNCTION may set `yank-undo-function' to override the UNDO value."
|
49318
|
2170 (let* ((handler (and (stringp string)
|
|
2171 (get-text-property 0 'yank-handler string)))
|
|
2172 (param (or (nth 1 handler) string))
|
73153
|
2173 (opoint (point))
|
75748
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2174 (inhibit-read-only inhibit-read-only)
|
73153
|
2175 end)
|
|
2176
|
49318
|
2177 (setq yank-undo-function t)
|
|
2178 (if (nth 0 handler) ;; FUNCTION
|
|
2179 (funcall (car handler) param)
|
49310
|
2180 (insert param))
|
73153
|
2181 (setq end (point))
|
|
2182
|
75748
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2183 ;; Prevent read-only properties from interfering with the
|
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2184 ;; following text property changes.
|
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2185 (setq inhibit-read-only t)
|
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
2186
|
73153
|
2187 ;; What should we do with `font-lock-face' properties?
|
|
2188 (if font-lock-defaults
|
|
2189 ;; No, just wipe them.
|
|
2190 (remove-list-of-text-properties opoint end '(font-lock-face))
|
|
2191 ;; Convert them to `face'.
|
|
2192 (save-excursion
|
|
2193 (goto-char opoint)
|
|
2194 (while (< (point) end)
|
|
2195 (let ((face (get-text-property (point) 'font-lock-face))
|
|
2196 run-end)
|
|
2197 (setq run-end
|
|
2198 (next-single-property-change (point) 'font-lock-face nil end))
|
|
2199 (when face
|
|
2200 (remove-text-properties (point) run-end '(font-lock-face nil))
|
|
2201 (put-text-property (point) run-end 'face face))
|
|
2202 (goto-char run-end)))))
|
|
2203
|
49318
|
2204 (unless (nth 2 handler) ;; NOEXCLUDE
|
49310
|
2205 (remove-yank-excluded-properties opoint (point)))
|
73415
|
2206
|
|
2207 ;; If last inserted char has properties, mark them as rear-nonsticky.
|
|
2208 (if (and (> end opoint)
|
|
2209 (text-properties-at (1- end)))
|
|
2210 (put-text-property (1- end) end 'rear-nonsticky t))
|
|
2211
|
49318
|
2212 (if (eq yank-undo-function t) ;; not set by FUNCTION
|
|
2213 (setq yank-undo-function (nth 3 handler))) ;; UNDO
|
|
2214 (if (nth 4 handler) ;; COMMAND
|
|
2215 (setq this-command (nth 4 handler)))))
|
49597
|
2216
|
55406
|
2217 (defun insert-buffer-substring-no-properties (buffer &optional start end)
|
|
2218 "Insert before point a substring of BUFFER, without text properties.
|
44723
|
2219 BUFFER may be a buffer or a buffer name.
|
55976
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2220 Arguments START and END are character positions specifying the substring.
|
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2221 They default to the values of (point-min) and (point-max) in BUFFER."
|
44723
|
2222 (let ((opoint (point)))
|
55406
|
2223 (insert-buffer-substring buffer start end)
|
44723
|
2224 (let ((inhibit-read-only t))
|
|
2225 (set-text-properties opoint (point) nil))))
|
|
2226
|
55406
|
2227 (defun insert-buffer-substring-as-yank (buffer &optional start end)
|
|
2228 "Insert before point a part of BUFFER, stripping some text properties.
|
|
2229 BUFFER may be a buffer or a buffer name.
|
55976
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2230 Arguments START and END are character positions specifying the substring.
|
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2231 They default to the values of (point-min) and (point-max) in BUFFER.
|
55406
|
2232 Strip text properties from the inserted text according to
|
|
2233 `yank-excluded-properties'."
|
52379
|
2234 ;; Since the buffer text should not normally have yank-handler properties,
|
|
2235 ;; there is no need to handle them here.
|
44723
|
2236 (let ((opoint (point)))
|
55406
|
2237 (insert-buffer-substring buffer start end)
|
44980
|
2238 (remove-yank-excluded-properties opoint (point))))
|
44723
|
2239
|
44668
|
2240
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2241 ;;;; Synchronous shell commands.
|
44668
|
2242
|
114
|
2243 (defun start-process-shell-command (name buffer &rest args)
|
|
2244 "Start a program in a subprocess. Return the process object for it.
|
|
2245 NAME is name for process. It is modified if necessary to make it unique.
|
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2246 BUFFER is the buffer (or buffer name) to associate with the process.
|
114
|
2247 Process output goes at end of that buffer, unless you specify
|
|
2248 an output stream or filter function to handle the output.
|
|
2249 BUFFER may be also nil, meaning that this process is not associated
|
|
2250 with any buffer
|
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2251 COMMAND is the name of a shell command.
|
73357
|
2252 Remaining arguments are the arguments for the command; they are all
|
|
2253 spliced together with blanks separating between each two of them, before
|
|
2254 passing the command to the shell.
|
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2255 Wildcards and redirection are handled as usual in the shell.
|
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2256
|
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2257 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)"
|
9822
|
2258 (cond
|
|
2259 ((eq system-type 'vax-vms)
|
|
2260 (apply 'start-process name buffer args))
|
10025
|
2261 ;; We used to use `exec' to replace the shell with the command,
|
|
2262 ;; but that failed to handle (...) and semicolon, etc.
|
9822
|
2263 (t
|
|
2264 (start-process name buffer shell-file-name shell-command-switch
|
10025
|
2265 (mapconcat 'identity args " ")))))
|
39598
|
2266
|
|
2267 (defun call-process-shell-command (command &optional infile buffer display
|
|
2268 &rest args)
|
|
2269 "Execute the shell command COMMAND synchronously in separate process.
|
|
2270 The remaining arguments are optional.
|
|
2271 The program's input comes from file INFILE (nil means `/dev/null').
|
|
2272 Insert output in BUFFER before point; t means current buffer;
|
|
2273 nil for BUFFER means discard it; 0 means discard and don't wait.
|
|
2274 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case,
|
|
2275 REAL-BUFFER says what to do with standard output, as above,
|
|
2276 while STDERR-FILE says what to do with standard error in the child.
|
|
2277 STDERR-FILE may be nil (discard standard error output),
|
|
2278 t (mix it with ordinary output), or a file name string.
|
|
2279
|
|
2280 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted.
|
|
2281 Remaining arguments are strings passed as additional arguments for COMMAND.
|
|
2282 Wildcards and redirection are handled as usual in the shell.
|
|
2283
|
|
2284 If BUFFER is 0, `call-process-shell-command' returns immediately with value nil.
|
|
2285 Otherwise it waits for COMMAND to terminate and returns a numeric exit
|
|
2286 status or a signal description string.
|
|
2287 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
|
|
2288 (cond
|
|
2289 ((eq system-type 'vax-vms)
|
|
2290 (apply 'call-process command infile buffer display args))
|
|
2291 ;; We used to use `exec' to replace the shell with the command,
|
|
2292 ;; but that failed to handle (...) and semicolon, etc.
|
|
2293 (t
|
|
2294 (call-process shell-file-name
|
|
2295 infile buffer display
|
|
2296 shell-command-switch
|
|
2297 (mapconcat 'identity (cons command args) " ")))))
|
16359
|
2298
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2299 ;;;; Lisp macros to do various things temporarily.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2300
|
16277
|
2301 (defmacro with-current-buffer (buffer &rest body)
|
71151
|
2302 "Execute the forms in BODY with BUFFER temporarily current.
|
71078
|
2303 BUFFER can be a buffer or a buffer name.
|
16379
|
2304 The value returned is the value of the last form in BODY.
|
|
2305 See also `with-temp-buffer'."
|
51051
|
2306 (declare (indent 1) (debug t))
|
|
2307 `(save-current-buffer
|
|
2308 (set-buffer ,buffer)
|
|
2309 ,@body))
|
|
2310
|
|
2311 (defmacro with-selected-window (window &rest body)
|
|
2312 "Execute the forms in BODY with WINDOW as the selected window.
|
|
2313 The value returned is the value of the last form in BODY.
|
63761
|
2314
|
|
2315 This macro saves and restores the current buffer, since otherwise
|
|
2316 its normal operation could potentially make a different
|
|
2317 buffer current. It does not alter the buffer list ordering.
|
|
2318
|
|
2319 This macro saves and restores the selected window, as well as
|
56402
|
2320 the selected window in each frame. If the previously selected
|
|
2321 window of some frame is no longer live at the end of BODY, that
|
|
2322 frame's selected window is left alone. If the selected window is
|
|
2323 no longer live, then whatever window is selected at the end of
|
|
2324 BODY remains selected.
|
51051
|
2325 See also `with-temp-buffer'."
|
|
2326 (declare (indent 1) (debug t))
|
55828
|
2327 ;; Most of this code is a copy of save-selected-window.
|
|
2328 `(let ((save-selected-window-window (selected-window))
|
|
2329 ;; It is necessary to save all of these, because calling
|
|
2330 ;; select-window changes frame-selected-window for whatever
|
|
2331 ;; frame that window is in.
|
|
2332 (save-selected-window-alist
|
|
2333 (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
|
|
2334 (frame-list))))
|
63761
|
2335 (save-current-buffer
|
|
2336 (unwind-protect
|
|
2337 (progn (select-window ,window 'norecord)
|
|
2338 ,@body)
|
|
2339 (dolist (elt save-selected-window-alist)
|
|
2340 (and (frame-live-p (car elt))
|
|
2341 (window-live-p (cadr elt))
|
|
2342 (set-frame-selected-window (car elt) (cadr elt))))
|
|
2343 (if (window-live-p save-selected-window-window)
|
|
2344 (select-window save-selected-window-window 'norecord))))))
|
16277
|
2345
|
83128
|
2346 (defmacro with-selected-frame (frame &rest body)
|
|
2347 "Execute the forms in BODY with FRAME as the selected frame.
|
|
2348 The value returned is the value of the last form in BODY.
|
|
2349 See also `with-temp-buffer'."
|
|
2350 (declare (indent 1) (debug t))
|
83488
|
2351 (let ((old-frame (make-symbol "old-frame"))
|
|
2352 (old-buffer (make-symbol "old-buffer")))
|
|
2353 `(let ((,old-frame (selected-frame))
|
|
2354 (,old-buffer (current-buffer)))
|
|
2355 (unwind-protect
|
|
2356 (progn (select-frame ,frame)
|
|
2357 ,@body)
|
|
2358 (if (frame-live-p ,old-frame)
|
|
2359 (select-frame ,old-frame))
|
|
2360 (if (buffer-live-p ,old-buffer)
|
|
2361 (set-buffer ,old-buffer))))))
|
83128
|
2362
|
23736
|
2363 (defmacro with-temp-file (file &rest body)
|
|
2364 "Create a new buffer, evaluate BODY there, and write the buffer to FILE.
|
|
2365 The value returned is the value of the last form in BODY.
|
16379
|
2366 See also `with-temp-buffer'."
|
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2367 (declare (debug t))
|
16359
|
2368 (let ((temp-file (make-symbol "temp-file"))
|
16379
|
2369 (temp-buffer (make-symbol "temp-buffer")))
|
|
2370 `(let ((,temp-file ,file)
|
|
2371 (,temp-buffer
|
|
2372 (get-buffer-create (generate-new-buffer-name " *temp file*"))))
|
|
2373 (unwind-protect
|
|
2374 (prog1
|
|
2375 (with-current-buffer ,temp-buffer
|
23736
|
2376 ,@body)
|
16379
|
2377 (with-current-buffer ,temp-buffer
|
|
2378 (widen)
|
|
2379 (write-region (point-min) (point-max) ,temp-file nil 0)))
|
|
2380 (and (buffer-name ,temp-buffer)
|
|
2381 (kill-buffer ,temp-buffer))))))
|
|
2382
|
23736
|
2383 (defmacro with-temp-message (message &rest body)
|
24011
|
2384 "Display MESSAGE temporarily if non-nil while BODY is evaluated.
|
23736
|
2385 The original message is restored to the echo area after BODY has finished.
|
|
2386 The value returned is the value of the last form in BODY.
|
24011
|
2387 MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
|
|
2388 If MESSAGE is nil, the echo area and message log buffer are unchanged.
|
|
2389 Use a MESSAGE of \"\" to temporarily clear the echo area."
|
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2390 (declare (debug t))
|
24000
|
2391 (let ((current-message (make-symbol "current-message"))
|
|
2392 (temp-message (make-symbol "with-temp-message")))
|
|
2393 `(let ((,temp-message ,message)
|
|
2394 (,current-message))
|
23736
|
2395 (unwind-protect
|
|
2396 (progn
|
24000
|
2397 (when ,temp-message
|
|
2398 (setq ,current-message (current-message))
|
24699
|
2399 (message "%s" ,temp-message))
|
23736
|
2400 ,@body)
|
42076
|
2401 (and ,temp-message
|
|
2402 (if ,current-message
|
|
2403 (message "%s" ,current-message)
|
|
2404 (message nil)))))))
|
23736
|
2405
|
|
2406 (defmacro with-temp-buffer (&rest body)
|
|
2407 "Create a temporary buffer, and evaluate BODY there like `progn'.
|
16379
|
2408 See also `with-temp-file' and `with-output-to-string'."
|
51051
|
2409 (declare (indent 0) (debug t))
|
16379
|
2410 (let ((temp-buffer (make-symbol "temp-buffer")))
|
57480
|
2411 `(let ((,temp-buffer (generate-new-buffer " *temp*")))
|
16379
|
2412 (unwind-protect
|
|
2413 (with-current-buffer ,temp-buffer
|
23736
|
2414 ,@body)
|
16379
|
2415 (and (buffer-name ,temp-buffer)
|
|
2416 (kill-buffer ,temp-buffer))))))
|
|
2417
|
16311
|
2418 (defmacro with-output-to-string (&rest body)
|
|
2419 "Execute BODY, return the text it sent to `standard-output', as a string."
|
51051
|
2420 (declare (indent 0) (debug t))
|
16379
|
2421 `(let ((standard-output
|
|
2422 (get-buffer-create (generate-new-buffer-name " *string-output*"))))
|
16311
|
2423 (let ((standard-output standard-output))
|
|
2424 ,@body)
|
16379
|
2425 (with-current-buffer standard-output
|
|
2426 (prog1
|
|
2427 (buffer-string)
|
|
2428 (kill-buffer nil)))))
|
16549
|
2429
|
40822
|
2430 (defmacro with-local-quit (&rest body)
|
56565
|
2431 "Execute BODY, allowing quits to terminate BODY but not escape further.
|
57547
|
2432 When a quit terminates BODY, `with-local-quit' returns nil but
|
70903
|
2433 requests another quit. That quit will be processed as soon as quitting
|
|
2434 is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
|
48475
|
2435 (declare (debug t) (indent 0))
|
40822
|
2436 `(condition-case nil
|
|
2437 (let ((inhibit-quit nil))
|
|
2438 ,@body)
|
70901
|
2439 (quit (setq quit-flag t)
|
|
2440 ;; This call is to give a chance to handle quit-flag
|
|
2441 ;; in case inhibit-quit is nil.
|
|
2442 ;; Without this, it will not be handled until the next function
|
|
2443 ;; call, and that might allow it to exit thru a condition-case
|
|
2444 ;; that intends to handle the quit signal next time.
|
|
2445 (eval '(ignore nil)))))
|
40822
|
2446
|
58934
|
2447 (defmacro while-no-input (&rest body)
|
|
2448 "Execute BODY only as long as there's no pending input.
|
|
2449 If input arrives, that ends the execution of BODY,
|
64792
|
2450 and `while-no-input' returns t. Quitting makes it return nil.
|
|
2451 If BODY finishes, `while-no-input' returns whatever value BODY produced."
|
58934
|
2452 (declare (debug t) (indent 0))
|
|
2453 (let ((catch-sym (make-symbol "input")))
|
|
2454 `(with-local-quit
|
|
2455 (catch ',catch-sym
|
|
2456 (let ((throw-on-input ',catch-sym))
|
72817
|
2457 (or (input-pending-p)
|
|
2458 ,@body))))))
|
58934
|
2459
|
16549
|
2460 (defmacro combine-after-change-calls (&rest body)
|
|
2461 "Execute BODY, but don't call the after-change functions till the end.
|
|
2462 If BODY makes changes in the buffer, they are recorded
|
|
2463 and the functions on `after-change-functions' are called several times
|
|
2464 when BODY is finished.
|
17146
|
2465 The return value is the value of the last form in BODY.
|
16549
|
2466
|
|
2467 If `before-change-functions' is non-nil, then calls to the after-change
|
|
2468 functions can't be deferred, so in that case this macro has no effect.
|
|
2469
|
|
2470 Do not alter `after-change-functions' or `before-change-functions'
|
|
2471 in BODY."
|
51051
|
2472 (declare (indent 0) (debug t))
|
16549
|
2473 `(unwind-protect
|
|
2474 (let ((combine-after-change-calls t))
|
|
2475 . ,body)
|
|
2476 (combine-after-change-execute)))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2477
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2478 ;;;; Constructing completion tables.
|
51695
|
2479
|
|
2480 (defmacro dynamic-completion-table (fun)
|
|
2481 "Use function FUN as a dynamic completion table.
|
|
2482 FUN is called with one argument, the string for which completion is required,
|
|
2483 and it should return an alist containing all the intended possible
|
51980
|
2484 completions. This alist may be a full list of possible completions so that FUN
|
|
2485 can ignore the value of its argument. If completion is performed in the
|
51695
|
2486 minibuffer, FUN will be called in the buffer from which the minibuffer was
|
51980
|
2487 entered.
|
|
2488
|
|
2489 The result of the `dynamic-completion-table' form is a function
|
|
2490 that can be used as the ALIST argument to `try-completion' and
|
|
2491 `all-completion'. See Info node `(elisp)Programmed Completion'."
|
63381
|
2492 (declare (debug (lambda-expr)))
|
51695
|
2493 (let ((win (make-symbol "window"))
|
|
2494 (string (make-symbol "string"))
|
|
2495 (predicate (make-symbol "predicate"))
|
|
2496 (mode (make-symbol "mode")))
|
|
2497 `(lambda (,string ,predicate ,mode)
|
|
2498 (with-current-buffer (let ((,win (minibuffer-selected-window)))
|
|
2499 (if (window-live-p ,win) (window-buffer ,win)
|
|
2500 (current-buffer)))
|
|
2501 (cond
|
|
2502 ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate))
|
|
2503 ((not ,mode) (try-completion ,string (,fun ,string) ,predicate))
|
|
2504 (t (test-completion ,string (,fun ,string) ,predicate)))))))
|
|
2505
|
67818
|
2506 (defmacro lazy-completion-table (var fun)
|
|
2507 ;; We used to have `&rest args' where `args' were evaluated late (at the
|
|
2508 ;; time of the call to `fun'), which was counter intuitive. But to get
|
|
2509 ;; them to be evaluated early, we have to either use lexical-let (which is
|
|
2510 ;; not available in subr.el) or use `(lambda (,str) ...) which prevents the use
|
|
2511 ;; of lexical-let in the callers.
|
|
2512 ;; So we just removed the argument. Callers can then simply use either of:
|
|
2513 ;; (lazy-completion-table var (lambda () (fun x y)))
|
|
2514 ;; or
|
|
2515 ;; (lazy-completion-table var `(lambda () (fun ',x ',y)))
|
|
2516 ;; or
|
|
2517 ;; (lexical-let ((x x)) ((y y))
|
|
2518 ;; (lazy-completion-table var (lambda () (fun x y))))
|
|
2519 ;; depending on the behavior they want.
|
51695
|
2520 "Initialize variable VAR as a lazy completion table.
|
67876
|
2521 If the completion table VAR is used for the first time (e.g., by passing VAR
|
67818
|
2522 as an argument to `try-completion'), the function FUN is called with no
|
|
2523 arguments. FUN must return the completion table that will be stored in VAR.
|
51980
|
2524 If completion is requested in the minibuffer, FUN will be called in the buffer
|
|
2525 from which the minibuffer was entered. The return value of
|
68400
|
2526 `lazy-completion-table' must be used to initialize the value of VAR.
|
|
2527
|
|
2528 You should give VAR a non-nil `risky-local-variable' property."
|
67818
|
2529 (declare (debug (symbol lambda-expr)))
|
51695
|
2530 (let ((str (make-symbol "string")))
|
|
2531 `(dynamic-completion-table
|
|
2532 (lambda (,str)
|
67651
915b73d58795
(lazy-completion-table): Don't be fooled if the var holds
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2533 (when (functionp ,var)
|
67818
|
2534 (setq ,var (,fun)))
|
51695
|
2535 ,var))))
|
63381
|
2536
|
|
2537 (defmacro complete-in-turn (a b)
|
|
2538 "Create a completion table that first tries completion in A and then in B.
|
|
2539 A and B should not be costly (or side-effecting) expressions."
|
|
2540 (declare (debug (def-form def-form)))
|
|
2541 `(lambda (string predicate mode)
|
|
2542 (cond
|
|
2543 ((eq mode t)
|
|
2544 (or (all-completions string ,a predicate)
|
|
2545 (all-completions string ,b predicate)))
|
|
2546 ((eq mode nil)
|
|
2547 (or (try-completion string ,a predicate)
|
|
2548 (try-completion string ,b predicate)))
|
|
2549 (t
|
|
2550 (or (test-completion string ,a predicate)
|
|
2551 (test-completion string ,b predicate))))))
|
16379
|
2552
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2553 ;;; Matching and match data.
|
44668
|
2554
|
15955
|
2555 (defvar save-match-data-internal)
|
|
2556
|
|
2557 ;; We use save-match-data-internal as the local variable because
|
|
2558 ;; that works ok in practice (people should not use that variable elsewhere).
|
|
2559 ;; We used to use an uninterned symbol; the compiler handles that properly
|
|
2560 ;; now, but it generates slower code.
|
2504
|
2561 (defmacro save-match-data (&rest body)
|
43527
|
2562 "Execute the BODY forms, restoring the global value of the match data.
|
|
2563 The value returned is the value of the last form in BODY."
|
26084
|
2564 ;; It is better not to use backquote here,
|
|
2565 ;; because that makes a bootstrapping problem
|
|
2566 ;; if you need to recompile all the Lisp files using interpreted code.
|
51051
|
2567 (declare (indent 0) (debug t))
|
26084
|
2568 (list 'let
|
|
2569 '((save-match-data-internal (match-data)))
|
|
2570 (list 'unwind-protect
|
|
2571 (cons 'progn body)
|
63664
|
2572 ;; It is safe to free (evaporate) markers immediately here,
|
|
2573 ;; as Lisp programs should not copy from save-match-data-internal.
|
63151
|
2574 '(set-match-data save-match-data-internal 'evaporate))))
|
144
|
2575
|
11115
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2576 (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>
diff
changeset
|
2577 "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>
diff
changeset
|
2578 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>
diff
changeset
|
2579 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>
diff
changeset
|
2580 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>
diff
changeset
|
2581 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>
diff
changeset
|
2582 (if (match-beginning num)
|
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2583 (if string
|
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
diff
changeset
|
2584 (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>
diff
changeset
|
2585 (buffer-substring (match-beginning num) (match-end num)))))
|
10560
|
2586
|
20491
|
2587 (defun match-string-no-properties (num &optional string)
|
|
2588 "Return string of text matched by last search, without text properties.
|
|
2589 NUM specifies which parenthesized expression in the last regexp.
|
|
2590 Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
|
|
2591 Zero means the entire text matched by the whole regexp or whole string.
|
|
2592 STRING should be given if the last search was by `string-match' on STRING."
|
|
2593 (if (match-beginning num)
|
|
2594 (if string
|
53994
|
2595 (substring-no-properties string (match-beginning num)
|
|
2596 (match-end num))
|
20491
|
2597 (buffer-substring-no-properties (match-beginning num)
|
|
2598 (match-end num)))))
|
|
2599
|
62861
|
2600 (defun looking-back (regexp &optional limit greedy)
|
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2601 "Return non-nil if text before point matches regular expression REGEXP.
|
57523
|
2602 Like `looking-at' except matches before point, and is slower.
|
72096
|
2603 LIMIT if non-nil speeds up the search by specifying a minimum
|
|
2604 starting position, to avoid checking matches that would start
|
|
2605 before LIMIT.
|
62861
|
2606
|
|
2607 If GREEDY is non-nil, extend the match backwards as far as possible,
|
|
2608 stopping when a single additional previous character cannot be part
|
|
2609 of a match for REGEXP."
|
|
2610 (let ((start (point))
|
|
2611 (pos
|
|
2612 (save-excursion
|
|
2613 (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
|
|
2614 (point)))))
|
|
2615 (if (and greedy pos)
|
|
2616 (save-restriction
|
|
2617 (narrow-to-region (point-min) start)
|
|
2618 (while (and (> pos (point-min))
|
|
2619 (save-excursion
|
|
2620 (goto-char pos)
|
|
2621 (backward-char 1)
|
|
2622 (looking-at (concat "\\(?:" regexp "\\)\\'"))))
|
|
2623 (setq pos (1- pos)))
|
|
2624 (save-excursion
|
|
2625 (goto-char pos)
|
|
2626 (looking-at (concat "\\(?:" regexp "\\)\\'")))))
|
|
2627 (not (null pos))))
|
|
2628
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2629 (defun subregexp-context-p (regexp pos &optional start)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2630 "Return non-nil if POS is in a normal subregexp context in REGEXP.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2631 A subregexp context is one where a sub-regexp can appear.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2632 A non-subregexp context is for example within brackets, or within a
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2633 repetition bounds operator `\\=\\{...\\}', or right after a `\\'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2634 If START is non-nil, it should be a position in REGEXP, smaller
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2635 than POS, and known to be in a subregexp context."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2636 ;; Here's one possible implementation, with the great benefit that it
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2637 ;; reuses the regexp-matcher's own parser, so it understands all the
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2638 ;; details of the syntax. A disadvantage is that it needs to match the
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2639 ;; error string.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2640 (condition-case err
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2641 (progn
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2642 (string-match (substring regexp (or start 0) pos) "")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2643 t)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2644 (invalid-regexp
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2645 (not (member (cadr err) '("Unmatched [ or [^"
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2646 "Unmatched \\{"
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2647 "Trailing backslash")))))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2648 ;; An alternative implementation:
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2649 ;; (defconst re-context-re
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2650 ;; (let* ((harmless-ch "[^\\[]")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2651 ;; (harmless-esc "\\\\[^{]")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2652 ;; (class-harmless-ch "[^][]")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2653 ;; (class-lb-harmless "[^]:]")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2654 ;; (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2655 ;; (class-lb (concat "\\[\\(" class-lb-harmless
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2656 ;; "\\|" class-lb-colon-maybe-charclass "\\)"))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2657 ;; (class
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2658 ;; (concat "\\[^?]?"
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2659 ;; "\\(" class-harmless-ch
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2660 ;; "\\|" class-lb "\\)*"
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2661 ;; "\\[?]")) ; special handling for bare [ at end of re
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2662 ;; (braces "\\\\{[0-9,]+\\\\}"))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2663 ;; (concat "\\`\\(" harmless-ch "\\|" harmless-esc
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2664 ;; "\\|" class "\\|" braces "\\)*\\'"))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2665 ;; "Matches any prefix that corresponds to a normal subregexp context.")
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2666 ;; (string-match re-context-re (substring regexp (or start 0) pos))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2667 )
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2668
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2669 ;;;; split-string
|
51339
14976a545668
(looking-back): New function to check for regular expression before point.
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2670
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2671 (defconst split-string-default-separators "[ \f\t\n\r\v]+"
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2672 "The default value of separators for `split-string'.
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2673
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2674 A regexp matching strings of whitespace. May be locale-dependent
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2675 \(as yet unimplemented). Should not match non-breaking spaces.
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2676
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2677 Warning: binding this to a different value and using it as default is
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2678 likely to have undesired semantics.")
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2679
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2680 ;; The specification says that if both SEPARATORS and OMIT-NULLS are
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2681 ;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2682 ;; expression leads to the equivalent implementation that if SEPARATORS
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2683 ;; is defaulted, OMIT-NULLS is treated as t.
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2684 (defun split-string (string &optional separators omit-nulls)
|
57006
|
2685 "Split STRING into substrings bounded by matches for SEPARATORS.
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2686
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2687 The beginning and end of STRING, and each match for SEPARATORS, are
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2688 splitting points. The substrings matching SEPARATORS are removed, and
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2689 the substrings between the splitting points are collected as a list,
|
16314
|
2690 which is returned.
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2691
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2692 If SEPARATORS is non-nil, it should be a regular expression matching text
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2693 which separates, but is not part of, the substrings. If nil it defaults to
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2694 `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2695 OMIT-NULLS is forced to t.
|
20476
|
2696
|
55406
|
2697 If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2698 that for the default value of SEPARATORS leading and trailing whitespace
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2699 are effectively trimmed). If nil, all zero-length substrings are retained,
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2700 which correctly parses CSV format, for example.
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2701
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2702 Note that the effect of `(split-string STRING)' is the same as
|
75124
|
2703 `(split-string STRING split-string-default-separators t)'. In the rare
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2704 case that you wish to retain zero-length substrings when splitting on
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2705 whitespace, use `(split-string STRING split-string-default-separators)'.
|
27810
|
2706
|
|
2707 Modifies the match data; use `save-match-data' if necessary."
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2708 (let ((keep-nulls (not (if separators omit-nulls t)))
|
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2709 (rexp (or separators split-string-default-separators))
|
16314
|
2710 (start 0)
|
20476
|
2711 notfirst
|
16314
|
2712 (list nil))
|
20476
|
2713 (while (and (string-match rexp string
|
|
2714 (if (and notfirst
|
|
2715 (= start (match-beginning 0))
|
|
2716 (< start (length string)))
|
|
2717 (1+ start) start))
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2718 (< start (length string)))
|
20476
|
2719 (setq notfirst t)
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2720 (if (or keep-nulls (< start (match-beginning 0)))
|
16314
|
2721 (setq list
|
|
2722 (cons (substring string start (match-beginning 0))
|
|
2723 list)))
|
|
2724 (setq start (match-end 0)))
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2725 (if (or keep-nulls (< start (length string)))
|
16314
|
2726 (setq list
|
|
2727 (cons (substring string start)
|
|
2728 list)))
|
|
2729 (nreverse list)))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2730
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2731 ;;;; Replacement in strings.
|
24089
|
2732
|
|
2733 (defun subst-char-in-string (fromchar tochar string &optional inplace)
|
|
2734 "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
|
|
2735 Unless optional argument INPLACE is non-nil, return a new string."
|
33835
|
2736 (let ((i (length string))
|
|
2737 (newstr (if inplace string (copy-sequence string))))
|
|
2738 (while (> i 0)
|
|
2739 (setq i (1- i))
|
|
2740 (if (eq (aref newstr i) fromchar)
|
|
2741 (aset newstr i tochar)))
|
|
2742 newstr))
|
27810
|
2743
|
28148
|
2744 (defun replace-regexp-in-string (regexp rep string &optional
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2745 fixedcase literal subexp start)
|
27810
|
2746 "Replace all matches for REGEXP with REP in STRING.
|
|
2747
|
|
2748 Return a new string containing the replacements.
|
|
2749
|
|
2750 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
|
|
2751 arguments with the same names of function `replace-match'. If START
|
|
2752 is non-nil, start replacements at that index in STRING.
|
|
2753
|
|
2754 REP is either a string used as the NEWTEXT arg of `replace-match' or a
|
65058
|
2755 function. If it is a function, it is called with the actual text of each
|
|
2756 match, and its value is used as the replacement text. When REP is called,
|
|
2757 the match-data are the result of matching REGEXP against a substring
|
|
2758 of STRING.
|
27810
|
2759
|
28148
|
2760 To replace only the first match (if any), make REGEXP match up to \\'
|
|
2761 and replace a sub-expression, e.g.
|
48077
|
2762 (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
|
28148
|
2763 => \" bar foo\"
|
|
2764 "
|
27810
|
2765
|
|
2766 ;; To avoid excessive consing from multiple matches in long strings,
|
|
2767 ;; don't just call `replace-match' continually. Walk down the
|
|
2768 ;; string looking for matches of REGEXP and building up a (reversed)
|
|
2769 ;; list MATCHES. This comprises segments of STRING which weren't
|
|
2770 ;; matched interspersed with replacements for segments that were.
|
39557
|
2771 ;; [For a `large' number of replacements it's more efficient to
|
27810
|
2772 ;; operate in a temporary buffer; we can't tell from the function's
|
|
2773 ;; args whether to choose the buffer-based implementation, though it
|
|
2774 ;; might be reasonable to do so for long enough STRING.]
|
|
2775 (let ((l (length string))
|
|
2776 (start (or start 0))
|
|
2777 matches str mb me)
|
|
2778 (save-match-data
|
|
2779 (while (and (< start l) (string-match regexp string start))
|
|
2780 (setq mb (match-beginning 0)
|
|
2781 me (match-end 0))
|
28065
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2782 ;; 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>
diff
changeset
|
2783 (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>
diff
changeset
|
2784 ;; Generate a replacement for the matched substring.
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2785 ;; 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>
diff
changeset
|
2786 ;; 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>
diff
changeset
|
2787 ;; 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>
diff
changeset
|
2788 ;; match data directly in Lisp.
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2789 (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>
diff
changeset
|
2790 (setq matches
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2791 (cons (replace-match (if (stringp rep)
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2792 rep
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2793 (funcall rep (match-string 0 str)))
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2794 fixedcase literal str subexp)
|
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
diff
changeset
|
2795 (cons (substring string start mb) ; unmatched prefix
|
28065
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2796 matches)))
|
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2797 (setq start me))
|
27810
|
2798 ;; Reconstruct a string from the pieces.
|
|
2799 (setq matches (cons (substring string start l) matches)) ; leftover
|
|
2800 (apply #'concat (nreverse matches)))))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2801
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2802 ;;;; invisibility specs
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2803
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2804 (defun add-to-invisibility-spec (element)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2805 "Add ELEMENT to `buffer-invisibility-spec'.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2806 See documentation for `buffer-invisibility-spec' for the kind of elements
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2807 that can be added."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2808 (if (eq buffer-invisibility-spec t)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2809 (setq buffer-invisibility-spec (list t)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2810 (setq buffer-invisibility-spec
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2811 (cons element buffer-invisibility-spec)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2812
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2813 (defun remove-from-invisibility-spec (element)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2814 "Remove ELEMENT from `buffer-invisibility-spec'."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2815 (if (consp buffer-invisibility-spec)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2816 (setq buffer-invisibility-spec (delete element buffer-invisibility-spec))))
|
16359
|
2817
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2818 ;;;; Syntax tables.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2819
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2820 (defmacro with-syntax-table (table &rest body)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2821 "Evaluate BODY with syntax table of current buffer set to TABLE.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2822 The syntax table of the current buffer is saved, BODY is evaluated, and the
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2823 saved table is restored, even in case of an abnormal exit.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2824 Value is what BODY returns."
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2825 (declare (debug t))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2826 (let ((old-table (make-symbol "table"))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2827 (old-buffer (make-symbol "buffer")))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2828 `(let ((,old-table (syntax-table))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2829 (,old-buffer (current-buffer)))
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2830 (unwind-protect
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2831 (progn
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2832 (set-syntax-table ,table)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2833 ,@body)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2834 (save-current-buffer
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2835 (set-buffer ,old-buffer)
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2836 (set-syntax-table ,old-table))))))
|
5385
|
2837
|
5844
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
diff
changeset
|
2838 (defun make-syntax-table (&optional oldtable)
|
5421
|
2839 "Return a new syntax table.
|
40822
|
2840 Create a syntax table which inherits from OLDTABLE (if non-nil) or
|
|
2841 from `standard-syntax-table' otherwise."
|
|
2842 (let ((table (make-char-table 'syntax-table nil)))
|
|
2843 (set-char-table-parent table (or oldtable (standard-syntax-table)))
|
|
2844 table))
|
17146
|
2845
|
47355
|
2846 (defun syntax-after (pos)
|
61798
|
2847 "Return the raw syntax of the char after POS.
|
|
2848 If POS is outside the buffer's accessible portion, return nil."
|
47355
|
2849 (unless (or (< pos (point-min)) (>= pos (point-max)))
|
58416
|
2850 (let ((st (if parse-sexp-lookup-properties
|
|
2851 (get-char-property pos 'syntax-table))))
|
|
2852 (if (consp st) st
|
|
2853 (aref (or st (syntax-table)) (char-after pos))))))
|
47355
|
2854
|
61669
|
2855 (defun syntax-class (syntax)
|
61798
|
2856 "Return the syntax class part of the syntax descriptor SYNTAX.
|
|
2857 If SYNTAX is nil, return nil."
|
|
2858 (and syntax (logand (car syntax) 65535)))
|
10825
|
2859
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2860 ;;;; Text clones
|
40282
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2861
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2862 (defun text-clone-maintain (ol1 after beg end &optional len)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2863 "Propagate the changes made under the overlay OL1 to the other clones.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2864 This is used on the `modification-hooks' property of text clones."
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2865 (when (and after (not undo-in-progress) (overlay-start ol1))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2866 (let ((margin (if (overlay-get ol1 'text-clone-spreadp) 1 0)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2867 (setq beg (max beg (+ (overlay-start ol1) margin)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2868 (setq end (min end (- (overlay-end ol1) margin)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2869 (when (<= beg end)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2870 (save-excursion
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2871 (when (overlay-get ol1 'text-clone-syntax)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2872 ;; Check content of the clone's text.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2873 (let ((cbeg (+ (overlay-start ol1) margin))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2874 (cend (- (overlay-end ol1) margin)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2875 (goto-char cbeg)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2876 (save-match-data
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2877 (if (not (re-search-forward
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2878 (overlay-get ol1 'text-clone-syntax) cend t))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2879 ;; Mark the overlay for deletion.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2880 (overlay-put ol1 'text-clones nil)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2881 (when (< (match-end 0) cend)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2882 ;; Shrink the clone at its end.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2883 (setq end (min end (match-end 0)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2884 (move-overlay ol1 (overlay-start ol1)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2885 (+ (match-end 0) margin)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2886 (when (> (match-beginning 0) cbeg)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2887 ;; Shrink the clone at its beginning.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2888 (setq beg (max (match-beginning 0) beg))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2889 (move-overlay ol1 (- (match-beginning 0) margin)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2890 (overlay-end ol1)))))))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2891 ;; Now go ahead and update the clones.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2892 (let ((head (- beg (overlay-start ol1)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2893 (tail (- (overlay-end ol1) end))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2894 (str (buffer-substring beg end))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2895 (nothing-left t)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2896 (inhibit-modification-hooks t))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2897 (dolist (ol2 (overlay-get ol1 'text-clones))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2898 (let ((oe (overlay-end ol2)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2899 (unless (or (eq ol1 ol2) (null oe))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2900 (setq nothing-left nil)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2901 (let ((mod-beg (+ (overlay-start ol2) head)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2902 ;;(overlay-put ol2 'modification-hooks nil)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2903 (goto-char (- (overlay-end ol2) tail))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2904 (unless (> mod-beg (point))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2905 (save-excursion (insert str))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2906 (delete-region mod-beg (point)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2907 ;;(overlay-put ol2 'modification-hooks '(text-clone-maintain))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2908 ))))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2909 (if nothing-left (delete-overlay ol1))))))))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2910
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2911 (defun text-clone-create (start end &optional spreadp syntax)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2912 "Create a text clone of START...END at point.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2913 Text clones are chunks of text that are automatically kept identical:
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2914 changes done to one of the clones will be immediately propagated to the other.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2915
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2916 The buffer's content at point is assumed to be already identical to
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2917 the one between START and END.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2918 If SYNTAX is provided it's a regexp that describes the possible text of
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2919 the clones; the clone will be shrunk or killed if necessary to ensure that
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2920 its text matches the regexp.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2921 If SPREADP is non-nil it indicates that text inserted before/after the
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2922 clone should be incorporated in the clone."
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2923 ;; To deal with SPREADP we can either use an overlay with `nil t' along
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2924 ;; with insert-(behind|in-front-of)-hooks or use a slightly larger overlay
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2925 ;; (with a one-char margin at each end) with `t nil'.
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2926 ;; We opted for a larger overlay because it behaves better in the case
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2927 ;; where the clone is reduced to the empty string (we want the overlay to
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2928 ;; stay when the clone's content is the empty string and we want to use
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2929 ;; `evaporate' to make sure those overlays get deleted when needed).
|
47916
|
2930 ;;
|
40282
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2931 (let* ((pt-end (+ (point) (- end start)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2932 (start-margin (if (or (not spreadp) (bobp) (<= start (point-min)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2933 0 1))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2934 (end-margin (if (or (not spreadp)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2935 (>= pt-end (point-max))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2936 (>= start (point-max)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2937 0 1))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2938 (ol1 (make-overlay (- start start-margin) (+ end end-margin) nil t))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2939 (ol2 (make-overlay (- (point) start-margin) (+ pt-end end-margin) nil t))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2940 (dups (list ol1 ol2)))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2941 (overlay-put ol1 'modification-hooks '(text-clone-maintain))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2942 (when spreadp (overlay-put ol1 'text-clone-spreadp t))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2943 (when syntax (overlay-put ol1 'text-clone-syntax syntax))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2944 ;;(overlay-put ol1 'face 'underline)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2945 (overlay-put ol1 'evaporate t)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2946 (overlay-put ol1 'text-clones dups)
|
47916
|
2947 ;;
|
40282
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2948 (overlay-put ol2 'modification-hooks '(text-clone-maintain))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2949 (when spreadp (overlay-put ol2 'text-clone-spreadp t))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2950 (when syntax (overlay-put ol2 'text-clone-syntax syntax))
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2951 ;;(overlay-put ol2 'face 'underline)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2952 (overlay-put ol2 'evaporate t)
|
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
2953 (overlay-put ol2 'text-clones dups)))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2954
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2955 ;;;; Mail user agents.
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2956
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2957 ;; Here we include just enough for other packages to be able
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2958 ;; to define them.
|
44422
|
2959
|
47406
|
2960 (defun define-mail-user-agent (symbol composefunc sendfunc
|
|
2961 &optional abortfunc hookvar)
|
|
2962 "Define a symbol to identify a mail-sending package for `mail-user-agent'.
|
|
2963
|
|
2964 SYMBOL can be any Lisp symbol. Its function definition and/or
|
|
2965 value as a variable do not matter for this usage; we use only certain
|
|
2966 properties on its property list, to encode the rest of the arguments.
|
|
2967
|
|
2968 COMPOSEFUNC is program callable function that composes an outgoing
|
|
2969 mail message buffer. This function should set up the basics of the
|
|
2970 buffer without requiring user interaction. It should populate the
|
|
2971 standard mail headers, leaving the `to:' and `subject:' headers blank
|
|
2972 by default.
|
|
2973
|
|
2974 COMPOSEFUNC should accept several optional arguments--the same
|
|
2975 arguments that `compose-mail' takes. See that function's documentation.
|
|
2976
|
|
2977 SENDFUNC is the command a user would run to send the message.
|
|
2978
|
|
2979 Optional ABORTFUNC is the command a user would run to abort the
|
|
2980 message. For mail packages that don't have a separate abort function,
|
|
2981 this can be `kill-buffer' (the equivalent of omitting this argument).
|
|
2982
|
|
2983 Optional HOOKVAR is a hook variable that gets run before the message
|
|
2984 is actually sent. Callers that use the `mail-user-agent' may
|
|
2985 install a hook function temporarily on this hook variable.
|
|
2986 If HOOKVAR is nil, `mail-send-hook' is used.
|
|
2987
|
|
2988 The properties used on SYMBOL are `composefunc', `sendfunc',
|
|
2989 `abortfunc', and `hookvar'."
|
|
2990 (put symbol 'composefunc composefunc)
|
|
2991 (put symbol 'sendfunc sendfunc)
|
|
2992 (put symbol 'abortfunc (or abortfunc 'kill-buffer))
|
|
2993 (put symbol 'hookvar (or hookvar 'mail-send-hook)))
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2994
|
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
2995 ;;;; Progress reporters.
|
57384
|
2996
|
|
2997 ;; Progress reporter has the following structure:
|
|
2998 ;;
|
|
2999 ;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
|
|
3000 ;; MIN-VALUE
|
|
3001 ;; MAX-VALUE
|
|
3002 ;; MESSAGE
|
|
3003 ;; MIN-CHANGE
|
|
3004 ;; MIN-TIME])
|
|
3005 ;;
|
|
3006 ;; This weirdeness is for optimization reasons: we want
|
|
3007 ;; `progress-reporter-update' to be as fast as possible, so
|
|
3008 ;; `(car reporter)' is better than `(aref reporter 0)'.
|
|
3009 ;;
|
|
3010 ;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple
|
|
3011 ;; digits of precision, it doesn't really matter here. On the other
|
|
3012 ;; hand, it greatly simplifies the code.
|
|
3013
|
57408
|
3014 (defsubst progress-reporter-update (reporter value)
|
|
3015 "Report progress of an operation in the echo area.
|
|
3016 However, if the change since last echo area update is too small
|
|
3017 or not enough time has passed, then do nothing (see
|
|
3018 `make-progress-reporter' for details).
|
|
3019
|
|
3020 First parameter, REPORTER, should be the result of a call to
|
|
3021 `make-progress-reporter'. Second, VALUE, determines the actual
|
|
3022 progress of operation; it must be between MIN-VALUE and MAX-VALUE
|
|
3023 as passed to `make-progress-reporter'.
|
|
3024
|
|
3025 This function is very inexpensive, you may not bother how often
|
|
3026 you call it."
|
|
3027 (when (>= value (car reporter))
|
|
3028 (progress-reporter-do-update reporter value)))
|
|
3029
|
57384
|
3030 (defun make-progress-reporter (message min-value max-value
|
|
3031 &optional current-value
|
|
3032 min-change min-time)
|
59648
|
3033 "Return progress reporter object to be used with `progress-reporter-update'.
|
57384
|
3034
|
|
3035 MESSAGE is shown in the echo area. When at least 1% of operation
|
|
3036 is complete, the exact percentage will be appended to the
|
|
3037 MESSAGE. When you call `progress-reporter-done', word \"done\"
|
|
3038 is printed after the MESSAGE. You can change MESSAGE of an
|
|
3039 existing progress reporter with `progress-reporter-force-update'.
|
|
3040
|
|
3041 MIN-VALUE and MAX-VALUE designate starting (0% complete) and
|
|
3042 final (100% complete) states of operation. The latter should be
|
|
3043 larger; if this is not the case, then simply negate all values.
|
|
3044 Optional CURRENT-VALUE specifies the progress by the moment you
|
|
3045 call this function. You should omit it or set it to nil in most
|
|
3046 cases since it defaults to MIN-VALUE.
|
|
3047
|
|
3048 Optional MIN-CHANGE determines the minimal change in percents to
|
|
3049 report (default is 1%.) Optional MIN-TIME specifies the minimal
|
|
3050 time before echo area updates (default is 0.2 seconds.) If
|
|
3051 `float-time' function is not present, then time is not tracked
|
|
3052 at all. If OS is not capable of measuring fractions of seconds,
|
|
3053 then this parameter is effectively rounded up."
|
|
3054
|
|
3055 (unless min-time
|
|
3056 (setq min-time 0.2))
|
|
3057 (let ((reporter
|
|
3058 (cons min-value ;; Force a call to `message' now
|
|
3059 (vector (if (and (fboundp 'float-time)
|
|
3060 (>= min-time 0.02))
|
|
3061 (float-time) nil)
|
|
3062 min-value
|
|
3063 max-value
|
|
3064 message
|
|
3065 (if min-change (max (min min-change 50) 1) 1)
|
|
3066 min-time))))
|
|
3067 (progress-reporter-update reporter (or current-value min-value))
|
|
3068 reporter))
|
|
3069
|
|
3070 (defun progress-reporter-force-update (reporter value &optional new-message)
|
|
3071 "Report progress of an operation in the echo area unconditionally.
|
|
3072
|
|
3073 First two parameters are the same as for
|
|
3074 `progress-reporter-update'. Optional NEW-MESSAGE allows you to
|
|
3075 change the displayed message."
|
|
3076 (let ((parameters (cdr reporter)))
|
|
3077 (when new-message
|
|
3078 (aset parameters 3 new-message))
|
|
3079 (when (aref parameters 0)
|
|
3080 (aset parameters 0 (float-time)))
|
|
3081 (progress-reporter-do-update reporter value)))
|
|
3082
|
|
3083 (defun progress-reporter-do-update (reporter value)
|
|
3084 (let* ((parameters (cdr reporter))
|
|
3085 (min-value (aref parameters 1))
|
|
3086 (max-value (aref parameters 2))
|
|
3087 (one-percent (/ (- max-value min-value) 100.0))
|
60764
|
3088 (percentage (if (= max-value min-value)
|
|
3089 0
|
|
3090 (truncate (/ (- value min-value) one-percent))))
|
57384
|
3091 (update-time (aref parameters 0))
|
|
3092 (current-time (float-time))
|
|
3093 (enough-time-passed
|
|
3094 ;; See if enough time has passed since the last update.
|
|
3095 (or (not update-time)
|
|
3096 (when (>= current-time update-time)
|
|
3097 ;; Calculate time for the next update
|
|
3098 (aset parameters 0 (+ update-time (aref parameters 5)))))))
|
|
3099 ;;
|
|
3100 ;; Calculate NEXT-UPDATE-VALUE. If we are not going to print
|
|
3101 ;; message this time because not enough time has passed, then use
|
|
3102 ;; 1 instead of MIN-CHANGE. This makes delays between echo area
|
|
3103 ;; updates closer to MIN-TIME.
|
|
3104 (setcar reporter
|
|
3105 (min (+ min-value (* (+ percentage
|
|
3106 (if enough-time-passed
|
|
3107 (aref parameters 4) ;; MIN-CHANGE
|
|
3108 1))
|
|
3109 one-percent))
|
|
3110 max-value))
|
|
3111 (when (integerp value)
|
|
3112 (setcar reporter (ceiling (car reporter))))
|
|
3113 ;;
|
|
3114 ;; Only print message if enough time has passed
|
|
3115 (when enough-time-passed
|
|
3116 (if (> percentage 0)
|
|
3117 (message "%s%d%%" (aref parameters 3) percentage)
|
|
3118 (message "%s" (aref parameters 3))))))
|
|
3119
|
|
3120 (defun progress-reporter-done (reporter)
|
|
3121 "Print reporter's message followed by word \"done\" in echo area."
|
|
3122 (message "%sdone" (aref (cdr reporter) 3)))
|
|
3123
|
59648
|
3124 (defmacro dotimes-with-progress-reporter (spec message &rest body)
|
|
3125 "Loop a certain number of times and report progress in the echo area.
|
|
3126 Evaluate BODY with VAR bound to successive integers running from
|
|
3127 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get
|
|
3128 the return value (nil if RESULT is omitted).
|
|
3129
|
|
3130 At each iteration MESSAGE followed by progress percentage is
|
|
3131 printed in the echo area. After the loop is finished, MESSAGE
|
|
3132 followed by word \"done\" is printed. This macro is a
|
|
3133 convenience wrapper around `make-progress-reporter' and friends.
|
|
3134
|
|
3135 \(fn (VAR COUNT [RESULT]) MESSAGE BODY...)"
|
|
3136 (declare (indent 2) (debug ((symbolp form &optional form) form body)))
|
|
3137 (let ((temp (make-symbol "--dotimes-temp--"))
|
|
3138 (temp2 (make-symbol "--dotimes-temp2--"))
|
|
3139 (start 0)
|
|
3140 (end (nth 1 spec)))
|
|
3141 `(let ((,temp ,end)
|
|
3142 (,(car spec) ,start)
|
|
3143 (,temp2 (make-progress-reporter ,message ,start ,end)))
|
|
3144 (while (< ,(car spec) ,temp)
|
|
3145 ,@body
|
|
3146 (progress-reporter-update ,temp2
|
|
3147 (setq ,(car spec) (1+ ,(car spec)))))
|
|
3148 (progress-reporter-done ,temp2)
|
|
3149 nil ,@(cdr (cdr spec)))))
|
65150
|
3150
|
65105
|
3151
|
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
3152 ;;;; Comparing version strings.
|
65105
|
3153
|
|
3154 (defvar version-separator "."
|
|
3155 "*Specify the string used to separate the version elements.
|
|
3156
|
|
3157 Usually the separator is \".\", but it can be any other string.")
|
|
3158
|
|
3159
|
|
3160 (defvar version-regexp-alist
|
67541
|
3161 '(("^[-_+ ]?a\\(lpha\\)?$" . -3)
|
73028
|
3162 ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
|
|
3163 ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
|
67541
|
3164 ("^[-_+ ]?b\\(eta\\)?$" . -2)
|
|
3165 ("^[-_+ ]?\\(pre\\|rc\\)$" . -1))
|
65105
|
3166 "*Specify association between non-numeric version part and a priority.
|
|
3167
|
|
3168 This association is used to handle version string like \"1.0pre2\",
|
|
3169 \"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the
|
|
3170 non-numeric part to an integer. For example:
|
|
3171
|
|
3172 String Version Integer List Version
|
|
3173 \"1.0pre2\" (1 0 -1 2)
|
|
3174 \"1.0PRE2\" (1 0 -1 2)
|
|
3175 \"22.8beta3\" (22 8 -2 3)
|
67541
|
3176 \"22.8 Beta3\" (22 8 -2 3)
|
65105
|
3177 \"0.9alpha1\" (0 9 -3 1)
|
|
3178 \"0.9AlphA1\" (0 9 -3 1)
|
67541
|
3179 \"0.9 alpha\" (0 9 -3)
|
65105
|
3180
|
|
3181 Each element has the following form:
|
|
3182
|
|
3183 (REGEXP . PRIORITY)
|
|
3184
|
|
3185 Where:
|
|
3186
|
|
3187 REGEXP regexp used to match non-numeric part of a version string.
|
65668
|
3188 It should begin with a `^' anchor and end with a `$' to
|
|
3189 prevent false hits. Letter-case is ignored while matching
|
|
3190 REGEXP.
|
65105
|
3191
|
|
3192 PRIORITY negative integer which indicate the non-numeric priority.")
|
|
3193
|
|
3194
|
|
3195 (defun version-to-list (ver)
|
|
3196 "Convert version string VER into an integer list.
|
|
3197
|
|
3198 The version syntax is given by the following EBNF:
|
|
3199
|
|
3200 VERSION ::= NUMBER ( SEPARATOR NUMBER )*.
|
|
3201
|
|
3202 NUMBER ::= (0|1|2|3|4|5|6|7|8|9)+.
|
|
3203
|
|
3204 SEPARATOR ::= `version-separator' (which see)
|
|
3205 | `version-regexp-alist' (which see).
|
|
3206
|
65668
|
3207 The NUMBER part is optional if SEPARATOR is a match for an element
|
|
3208 in `version-regexp-alist'.
|
|
3209
|
65105
|
3210 As an example of valid version syntax:
|
|
3211
|
65668
|
3212 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta
|
65105
|
3213
|
|
3214 As an example of invalid version syntax:
|
|
3215
|
|
3216 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5
|
|
3217
|
|
3218 As an example of version convertion:
|
|
3219
|
|
3220 String Version Integer List Version
|
|
3221 \"1.0.7.5\" (1 0 7 5)
|
|
3222 \"1.0pre2\" (1 0 -1 2)
|
|
3223 \"1.0PRE2\" (1 0 -1 2)
|
|
3224 \"22.8beta3\" (22 8 -2 3)
|
|
3225 \"22.8Beta3\" (22 8 -2 3)
|
|
3226 \"0.9alpha1\" (0 9 -3 1)
|
|
3227 \"0.9AlphA1\" (0 9 -3 1)
|
|
3228 \"0.9alpha\" (0 9 -3)
|
|
3229
|
|
3230 See documentation for `version-separator' and `version-regexp-alist'."
|
67541
|
3231 (or (and (stringp ver) (> (length ver) 0))
|
65105
|
3232 (error "Invalid version string: '%s'" ver))
|
67541
|
3233 ;; Change .x.y to 0.x.y
|
|
3234 (if (and (>= (length ver) (length version-separator))
|
|
3235 (string-equal (substring ver 0 (length version-separator))
|
|
3236 version-separator))
|
|
3237 (setq ver (concat "0" ver)))
|
65105
|
3238 (save-match-data
|
|
3239 (let ((i 0)
|
65668
|
3240 (case-fold-search t) ; ignore case in matching
|
65105
|
3241 lst s al)
|
|
3242 (while (and (setq s (string-match "[0-9]+" ver i))
|
|
3243 (= s i))
|
|
3244 ;; handle numeric part
|
|
3245 (setq lst (cons (string-to-number (substring ver i (match-end 0)))
|
|
3246 lst)
|
|
3247 i (match-end 0))
|
|
3248 ;; handle non-numeric part
|
|
3249 (when (and (setq s (string-match "[^0-9]+" ver i))
|
|
3250 (= s i))
|
|
3251 (setq s (substring ver i (match-end 0))
|
|
3252 i (match-end 0))
|
|
3253 ;; handle alpha, beta, pre, etc. separator
|
|
3254 (unless (string= s version-separator)
|
|
3255 (setq al version-regexp-alist)
|
|
3256 (while (and al (not (string-match (caar al) s)))
|
|
3257 (setq al (cdr al)))
|
|
3258 (or al (error "Invalid version syntax: '%s'" ver))
|
|
3259 (setq lst (cons (cdar al) lst)))))
|
|
3260 (if (null lst)
|
|
3261 (error "Invalid version syntax: '%s'" ver)
|
|
3262 (nreverse lst)))))
|
|
3263
|
|
3264
|
65150
|
3265 (defun version-list-< (l1 l2)
|
65105
|
3266 "Return t if integer list L1 is lesser than L2.
|
|
3267
|
|
3268 Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
|
|
3269 etc. That is, the trailing zeroes are irrelevant. Also, integer
|
|
3270 list (1) is greater than (1 -1) which is greater than (1 -2)
|
|
3271 which is greater than (1 -3)."
|
|
3272 (while (and l1 l2 (= (car l1) (car l2)))
|
|
3273 (setq l1 (cdr l1)
|
|
3274 l2 (cdr l2)))
|
|
3275 (cond
|
|
3276 ;; l1 not null and l2 not null
|
|
3277 ((and l1 l2) (< (car l1) (car l2)))
|
|
3278 ;; l1 null and l2 null ==> l1 length = l2 length
|
|
3279 ((and (null l1) (null l2)) nil)
|
|
3280 ;; l1 not null and l2 null ==> l1 length > l2 length
|
65150
|
3281 (l1 (< (version-list-not-zero l1) 0))
|
65105
|
3282 ;; l1 null and l2 not null ==> l2 length > l1 length
|
65150
|
3283 (t (< 0 (version-list-not-zero l2)))))
|
|
3284
|
|
3285
|
|
3286 (defun version-list-= (l1 l2)
|
65105
|
3287 "Return t if integer list L1 is equal to L2.
|
|
3288
|
|
3289 Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
|
|
3290 etc. That is, the trailing zeroes are irrelevant. Also, integer
|
|
3291 list (1) is greater than (1 -1) which is greater than (1 -2)
|
|
3292 which is greater than (1 -3)."
|
|
3293 (while (and l1 l2 (= (car l1) (car l2)))
|
|
3294 (setq l1 (cdr l1)
|
|
3295 l2 (cdr l2)))
|
|
3296 (cond
|
|
3297 ;; l1 not null and l2 not null
|
|
3298 ((and l1 l2) nil)
|
|
3299 ;; l1 null and l2 null ==> l1 length = l2 length
|
|
3300 ((and (null l1) (null l2)))
|
|
3301 ;; l1 not null and l2 null ==> l1 length > l2 length
|
65150
|
3302 (l1 (zerop (version-list-not-zero l1)))
|
65105
|
3303 ;; l1 null and l2 not null ==> l2 length > l1 length
|
65150
|
3304 (t (zerop (version-list-not-zero l2)))))
|
|
3305
|
|
3306
|
|
3307 (defun version-list-<= (l1 l2)
|
65105
|
3308 "Return t if integer list L1 is lesser than or equal to L2.
|
|
3309
|
|
3310 Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
|
|
3311 etc. That is, the trailing zeroes are irrelevant. Also, integer
|
|
3312 list (1) is greater than (1 -1) which is greater than (1 -2)
|
|
3313 which is greater than (1 -3)."
|
|
3314 (while (and l1 l2 (= (car l1) (car l2)))
|
|
3315 (setq l1 (cdr l1)
|
|
3316 l2 (cdr l2)))
|
|
3317 (cond
|
|
3318 ;; l1 not null and l2 not null
|
|
3319 ((and l1 l2) (< (car l1) (car l2)))
|
|
3320 ;; l1 null and l2 null ==> l1 length = l2 length
|
|
3321 ((and (null l1) (null l2)))
|
|
3322 ;; l1 not null and l2 null ==> l1 length > l2 length
|
65150
|
3323 (l1 (<= (version-list-not-zero l1) 0))
|
65105
|
3324 ;; l1 null and l2 not null ==> l2 length > l1 length
|
65150
|
3325 (t (<= 0 (version-list-not-zero l2)))))
|
|
3326
|
|
3327 (defun version-list-not-zero (lst)
|
|
3328 "Return the first non-zero element of integer list LST.
|
|
3329
|
|
3330 If all LST elements are zeroes or LST is nil, return zero."
|
|
3331 (while (and lst (zerop (car lst)))
|
|
3332 (setq lst (cdr lst)))
|
|
3333 (if lst
|
|
3334 (car lst)
|
|
3335 ;; there is no element different of zero
|
|
3336 0))
|
65105
|
3337
|
|
3338
|
|
3339 (defun version< (v1 v2)
|
|
3340 "Return t if version V1 is lesser than V2.
|
|
3341
|
|
3342 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
|
|
3343 etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
|
|
3344 is greater than \"1pre\" which is greater than \"1beta\" which is greater than
|
|
3345 \"1alpha\"."
|
65150
|
3346 (version-list-< (version-to-list v1) (version-to-list v2)))
|
65105
|
3347
|
|
3348
|
|
3349 (defun version<= (v1 v2)
|
|
3350 "Return t if version V1 is lesser than or equal to V2.
|
|
3351
|
|
3352 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
|
|
3353 etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
|
|
3354 is greater than \"1pre\" which is greater than \"1beta\" which is greater than
|
|
3355 \"1alpha\"."
|
65150
|
3356 (version-list-<= (version-to-list v1) (version-to-list v2)))
|
|
3357
|
|
3358 (defun version= (v1 v2)
|
|
3359 "Return t if version V1 is equal to V2.
|
|
3360
|
|
3361 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
|
|
3362 etc. That is, the trailing \".0\"s are irrelevant. Also, version string \"1\"
|
|
3363 is greater than \"1pre\" which is greater than \"1beta\" which is greater than
|
|
3364 \"1alpha\"."
|
|
3365 (version-list-= (version-to-list v1) (version-to-list v2)))
|
|
3366
|
65105
|
3367
|
59648
|
3368
|
57151
|
3369 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc
|
787
|
3370 ;;; subr.el ends here
|