Mercurial > emacs
annotate lisp/subr.el @ 44800:c5e37bb207a2
*** empty log message ***
author | Martin Stjernholm <mast@lysator.liu.se> |
---|---|
date | Wed, 24 Apr 2002 00:50:29 +0000 |
parents | f5b7b7055a64 |
children | e4975d9c93ff |
rev | line source |
---|---|
658
7cbd4fcd8b0f
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
648
diff
changeset
|
1 ;;; subr.el --- basic lisp subroutines for Emacs |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
2 |
44129
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
3 ;; Copyright (C) 1985, 86, 92, 94, 95, 99, 2000, 2001, 2002 |
36094
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
4 ;; Free Software Foundation, Inc. |
114 | 5 |
6 ;; This file is part of GNU Emacs. | |
7 | |
8 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
9 ;; it under the terms of the GNU General Public License as published by | |
707 | 10 ;; the Free Software Foundation; either version 2, or (at your option) |
114 | 11 ;; any later version. |
12 | |
13 ;; GNU Emacs is distributed in the hope that it will be useful, | |
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 ;; GNU General Public License for more details. | |
17 | |
18 ;; You should have received a copy of the GNU General Public License | |
14169 | 19 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
20 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
21 ;; Boston, MA 02111-1307, USA. | |
114 | 22 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37070
diff
changeset
|
23 ;;; Commentary: |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37070
diff
changeset
|
24 |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
25 ;;; Code: |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
26 (defvar custom-declare-variable-list nil |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
27 "Record `defcustom' calls made before `custom.el' is loaded to handle them. |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
28 Each element of this list holds the arguments to one call to `defcustom'.") |
114 | 29 |
19662 | 30 ;; Use this, rather than defcustom, in subr.el and other files loaded |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
31 ;; before custom.el. |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
32 (defun custom-declare-variable-early (&rest arguments) |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
33 (setq custom-declare-variable-list |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
34 (cons arguments custom-declare-variable-list))) |
44129
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
35 |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
36 |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
37 (defun macro-declaration-function (macro decl) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
38 "Process a declaration found in a macro definition. |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
39 This is set as the value of the variable `macro-declaration-function'. |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
40 MACRO is the name of the macro being defined. |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
41 DECL is a list `(declare ...)' containing the declarations. |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
42 The return value of this function is not used." |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
43 (dolist (d (cdr decl)) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
44 (cond ((and (consp d) (eq (car d) 'indent)) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
45 (put macro 'lisp-indent-function (cadr d))) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
46 ((and (consp d) (eq (car d) 'debug)) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
47 (put macro 'edebug-form-spec (cadr d))) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
48 (t |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
49 (message "Unknown declaration %s" d))))) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
50 |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
51 (setq macro-declaration-function 'macro-declaration-function) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
52 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
53 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
54 ;;;; Lisp language features. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
55 |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
56 (defalias 'not 'null) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
57 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
58 (defmacro lambda (&rest cdr) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
59 "Return a lambda expression. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
60 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
61 self-quoting; the result of evaluating the lambda expression is the |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
62 expression itself. The lambda expression may then be treated as a |
10178 | 63 function, i.e., stored as the function value of a symbol, passed to |
64 funcall or mapcar, etc. | |
65 | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
66 ARGS should take the same form as an argument list for a `defun'. |
12395 | 67 DOCSTRING is an optional documentation string. |
68 If present, it should describe how to call the function. | |
69 But documentation strings are usually not useful in nameless functions. | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
70 INTERACTIVE should be a call to the function `interactive', which see. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
71 It may also be omitted. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
72 BODY should be a list of lisp expressions." |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
73 ;; Note that this definition should not use backquotes; subr.el should not |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
74 ;; depend on backquote.el. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
75 (list 'function (cons 'lambda cdr))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
76 |
25437 | 77 (defmacro push (newelt listname) |
25580 | 78 "Add NEWELT to the list stored in the symbol LISTNAME. |
25437 | 79 This is equivalent to (setq LISTNAME (cons NEWELT LISTNAME)). |
25436
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
80 LISTNAME must be a symbol." |
25469 | 81 (list 'setq listname |
82 (list 'cons newelt listname))) | |
25436
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
83 |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
84 (defmacro pop (listname) |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
85 "Return the first element of LISTNAME's value, and remove it from the list. |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
86 LISTNAME must be a symbol whose value is a list. |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
87 If the value is nil, `pop' returns nil but does not actually |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
88 change the list." |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
89 (list 'prog1 (list 'car listname) |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
90 (list 'setq listname (list 'cdr listname)))) |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
91 |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
92 (defmacro when (cond &rest body) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
93 "If COND yields non-nil, do BODY, else return nil." |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
94 (list 'if cond (cons 'progn body))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
95 |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
96 (defmacro unless (cond &rest body) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
97 "If COND yields nil, do BODY, else return nil." |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
98 (cons 'if (cons cond (cons nil body)))) |
19491
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
99 |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
100 (defmacro dolist (spec &rest body) |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
101 "(dolist (VAR LIST [RESULT]) BODY...): loop over a list. |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
102 Evaluate BODY with VAR bound to each car from LIST, in turn. |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
103 Then evaluate RESULT to get return value, default nil." |
27383
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
104 (let ((temp (make-symbol "--dolist-temp--"))) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
105 (list 'let (list (list temp (nth 1 spec)) (car spec)) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
106 (list 'while temp |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
107 (list 'setq (car spec) (list 'car temp)) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
108 (cons 'progn |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
109 (append body |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
110 (list (list 'setq temp (list 'cdr temp)))))) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
111 (if (cdr (cdr spec)) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
112 (cons 'progn |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
113 (cons (list 'setq (car spec) nil) (cdr (cdr spec)))))))) |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
114 |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
115 (defmacro dotimes (spec &rest body) |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
116 "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times. |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
117 Evaluate BODY with VAR bound to successive integers running from 0, |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
118 inclusive, to COUNT, exclusive. Then evaluate RESULT to get |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
119 the return value (nil if RESULT is omitted)." |
27383
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
120 (let ((temp (make-symbol "--dotimes-temp--"))) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
121 (list 'let (list (list temp (nth 1 spec)) (list (car spec) 0)) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
122 (list 'while (list '< (car spec) temp) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
123 (cons 'progn |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
124 (append body (list (list 'setq (car spec) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
125 (list '1+ (car spec))))))) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
126 (if (cdr (cdr spec)) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
127 (car (cdr (cdr spec))) |
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
128 nil)))) |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
129 |
19491
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
130 (defsubst caar (x) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
131 "Return the car of the car of X." |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
132 (car (car x))) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
133 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
134 (defsubst cadr (x) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
135 "Return the car of the cdr of X." |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
136 (car (cdr x))) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
137 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
138 (defsubst cdar (x) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
139 "Return the cdr of the car of X." |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
140 (cdr (car x))) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
141 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
142 (defsubst cddr (x) |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
143 "Return the cdr of the cdr of X." |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
144 (cdr (cdr x))) |
19492 | 145 |
19584
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
146 (defun last (x &optional n) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
147 "Return the last link of the list X. Its car is the last element. |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
148 If X is nil, return nil. |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
149 If N is non-nil, return the Nth-to-last link of X. |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
150 If N is bigger than the length of X, return X." |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
151 (if n |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
152 (let ((m 0) (p x)) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
153 (while (consp p) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
154 (setq m (1+ m) p (cdr p))) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
155 (if (<= n 0) p |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
156 (if (< n m) (nthcdr (- m n) x) x))) |
35281
be18bd846968
(last): Handle a list that doesn't end in nil.
Richard M. Stallman <rms@gnu.org>
parents:
35231
diff
changeset
|
157 (while (consp (cdr x)) |
19584
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
158 (setq x (cdr x))) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
159 x)) |
22860
349fa4ee1f27
(assoc-default): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22755
diff
changeset
|
160 |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
161 (defun butlast (x &optional n) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
162 "Returns a copy of LIST with the last N elements removed." |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
163 (if (and n (<= n 0)) x |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
164 (nbutlast (copy-sequence x) n))) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
165 |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
166 (defun nbutlast (x &optional n) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
167 "Modifies LIST to remove the last N elements." |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
168 (let ((m (length x))) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
169 (or n (setq n 1)) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
170 (and (< n m) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
171 (progn |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
172 (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil)) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
173 x)))) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
174 |
30515
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
175 (defun remove (elt seq) |
42941 | 176 "Return a copy of SEQ with all occurrences of ELT removed. |
30515
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
177 SEQ must be a list, vector, or string. The comparison is done with `equal'." |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
178 (if (nlistp seq) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
179 ;; If SEQ isn't a list, there's no need to copy SEQ because |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
180 ;; `delete' will return a new object. |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
181 (delete elt seq) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
182 (delete elt (copy-sequence seq)))) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
183 |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
184 (defun remq (elt list) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
185 "Return a copy of LIST with all occurences of ELT removed. |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
186 The comparison is done with `eq'." |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
187 (if (memq elt list) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
188 (delq elt (copy-sequence list)) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
189 list)) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
190 |
22959
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
191 (defun assoc-default (key alist &optional test default) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
192 "Find object KEY in a pseudo-alist ALIST. |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
193 ALIST is a list of conses or objects. Each element (or the element's car, |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
194 if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY). |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
195 If that is non-nil, the element matches; |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
196 then `assoc-default' returns the element's cdr, if it is a cons, |
22860
349fa4ee1f27
(assoc-default): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22755
diff
changeset
|
197 or DEFAULT if the element is not a cons. |
22959
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
198 |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
199 If no element matches, the value is nil. |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
200 If TEST is omitted or nil, `equal' is used." |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
201 (let (found (tail alist) value) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
202 (while (and tail (not found)) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
203 (let ((elt (car tail))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
204 (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
205 (setq found t value (if (consp elt) (cdr elt) default)))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
206 (setq tail (cdr tail))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
207 value)) |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
208 |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
209 (defun assoc-ignore-case (key alist) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
210 "Like `assoc', but ignores differences in case and text representation. |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
211 KEY must be a string. Upper-case and lower-case letters are treated as equal. |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
212 Unibyte strings are converted to multibyte for comparison." |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
213 (let (element) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
214 (while (and alist (not element)) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
215 (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil t)) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
216 (setq element (car alist))) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
217 (setq alist (cdr alist))) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
218 element)) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
219 |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
220 (defun assoc-ignore-representation (key alist) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
221 "Like `assoc', but ignores differences in text representation. |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
222 KEY must be a string. |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
223 Unibyte strings are converted to multibyte for comparison." |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
224 (let (element) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
225 (while (and alist (not element)) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
226 (if (eq t (compare-strings key 0 nil (car (car alist)) 0 nil)) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
227 (setq element (car alist))) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
228 (setq alist (cdr alist))) |
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
229 element)) |
28490
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
230 |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
231 (defun member-ignore-case (elt list) |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
232 "Like `member', but ignores differences in case and text representation. |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
233 ELT must be a string. Upper-case and lower-case letters are treated as equal. |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
234 Unibyte strings are converted to multibyte for comparison." |
33978
9aa3fd6779f7
(member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents:
33835
diff
changeset
|
235 (while (and list (not (eq t (compare-strings elt 0 nil (car list) 0 nil t)))) |
9aa3fd6779f7
(member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents:
33835
diff
changeset
|
236 (setq list (cdr list))) |
9aa3fd6779f7
(member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents:
33835
diff
changeset
|
237 list) |
28490
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
238 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
239 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
240 ;;;; Keymap support. |
114 | 241 |
242 (defun undefined () | |
243 (interactive) | |
244 (ding)) | |
245 | |
246 ;Prevent the \{...} documentation construct | |
247 ;from mentioning keys that run this command. | |
248 (put 'undefined 'suppress-keymap t) | |
249 | |
250 (defun suppress-keymap (map &optional nodigits) | |
251 "Make MAP override all normally self-inserting keys to be undefined. | |
252 Normally, as an exception, digits and minus-sign are set to make prefix args, | |
253 but optional second arg NODIGITS non-nil treats them like other chars." | |
4767
12ff77449baa
(suppress-keymap): Use substitute-key-definition instead of manually
Brian Fox <bfox@gnu.org>
parents:
4620
diff
changeset
|
254 (substitute-key-definition 'self-insert-command 'undefined map global-map) |
114 | 255 (or nodigits |
256 (let (loop) | |
257 (define-key map "-" 'negative-argument) | |
258 ;; Make plain numbers do numeric args. | |
259 (setq loop ?0) | |
260 (while (<= loop ?9) | |
261 (define-key map (char-to-string loop) 'digit-argument) | |
262 (setq loop (1+ loop)))))) | |
263 | |
264 ;Moved to keymap.c | |
265 ;(defun copy-keymap (keymap) | |
266 ; "Return a copy of KEYMAP" | |
267 ; (while (not (keymapp keymap)) | |
268 ; (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap)))) | |
269 ; (if (vectorp keymap) | |
270 ; (copy-sequence keymap) | |
271 ; (copy-alist keymap))) | |
272 | |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
273 (defvar key-substitution-in-progress nil |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
274 "Used internally by substitute-key-definition.") |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
275 |
1176 | 276 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) |
114 | 277 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. |
278 In other words, OLDDEF is replaced with NEWDEF where ever it appears. | |
28811
8a7623ffeeac
(substitute-key-definition): Clarify documentation.
Gerd Moellmann <gerd@gnu.org>
parents:
28794
diff
changeset
|
279 Alternatively, if optional fourth argument OLDMAP is specified, we redefine |
32131
3a54b3a6bf40
(substitute-key-definition): Doc fix.
Dave Love <fx@gnu.org>
parents:
31979
diff
changeset
|
280 in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP." |
28868
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
281 ;; Don't document PREFIX in the doc string because we don't want to |
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
282 ;; advertise it. It's meant for recursive calls only. Here's its |
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
283 ;; meaning |
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
284 |
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
285 ;; If optional argument PREFIX is specified, it should be a key |
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
286 ;; prefix, a string. Redefined bindings will then be bound to the |
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
287 ;; original key, with PREFIX added at the front. |
1176 | 288 (or prefix (setq prefix "")) |
289 (let* ((scan (or oldmap keymap)) | |
290 (vec1 (vector nil)) | |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
291 (prefix1 (vconcat prefix vec1)) |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
292 (key-substitution-in-progress |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
293 (cons scan key-substitution-in-progress))) |
1176 | 294 ;; Scan OLDMAP, finding each char or event-symbol that |
295 ;; has any definition, and act on it with hack-key. | |
296 (while (consp scan) | |
297 (if (consp (car scan)) | |
298 (let ((char (car (car scan))) | |
299 (defn (cdr (car scan)))) | |
300 ;; The inside of this let duplicates exactly | |
301 ;; the inside of the following let that handles array elements. | |
302 (aset vec1 0 char) | |
303 (aset prefix1 (length prefix) char) | |
6005
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
304 (let (inner-def skipped) |
1176 | 305 ;; Skip past menu-prompt. |
306 (while (stringp (car-safe defn)) | |
6005
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
307 (setq skipped (cons (car defn) skipped)) |
1176 | 308 (setq defn (cdr defn))) |
7615
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
309 ;; Skip past cached key-equivalence data for menu items. |
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
310 (and (consp defn) (consp (car defn)) |
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
311 (setq defn (cdr defn))) |
1176 | 312 (setq inner-def defn) |
7615
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
313 ;; Look past a symbol that names a keymap. |
1176 | 314 (while (and (symbolp inner-def) |
315 (fboundp inner-def)) | |
316 (setq inner-def (symbol-function inner-def))) | |
17215
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
317 (if (or (eq defn olddef) |
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
318 ;; Compare with equal if definition is a key sequence. |
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
319 ;; That is useful for operating on function-key-map. |
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
320 (and (or (stringp defn) (vectorp defn)) |
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
321 (equal defn olddef))) |
6005
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
322 (define-key keymap prefix1 (nconc (nreverse skipped) newdef)) |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
323 (if (and (keymapp defn) |
9986
df605fcd1e75
(substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
9822
diff
changeset
|
324 ;; Avoid recursively scanning |
df605fcd1e75
(substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
9822
diff
changeset
|
325 ;; where KEYMAP does not have a submap. |
13039
04ffbdd37d2d
(substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
12730
diff
changeset
|
326 (let ((elt (lookup-key keymap prefix1))) |
04ffbdd37d2d
(substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
12730
diff
changeset
|
327 (or (null elt) |
04ffbdd37d2d
(substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
12730
diff
changeset
|
328 (keymapp elt))) |
9986
df605fcd1e75
(substitute-key-definition): Don't recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
9822
diff
changeset
|
329 ;; Avoid recursively rescanning keymap being scanned. |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
330 (not (memq inner-def |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
331 key-substitution-in-progress))) |
7615
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
332 ;; If this one isn't being scanned already, |
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
333 ;; scan it now. |
1176 | 334 (substitute-key-definition olddef newdef keymap |
335 inner-def | |
336 prefix1))))) | |
18044
3e4924d01221
(substitute-key-definition): Check vectorp, not arrayp.
Richard M. Stallman <rms@gnu.org>
parents:
17943
diff
changeset
|
337 (if (vectorp (car scan)) |
1176 | 338 (let* ((array (car scan)) |
339 (len (length array)) | |
340 (i 0)) | |
341 (while (< i len) | |
342 (let ((char i) (defn (aref array i))) | |
343 ;; The inside of this let duplicates exactly | |
344 ;; the inside of the previous let. | |
345 (aset vec1 0 char) | |
346 (aset prefix1 (length prefix) char) | |
6005
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
347 (let (inner-def skipped) |
1176 | 348 ;; Skip past menu-prompt. |
349 (while (stringp (car-safe defn)) | |
6005
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
350 (setq skipped (cons (car defn) skipped)) |
1176 | 351 (setq defn (cdr defn))) |
7615
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
352 (and (consp defn) (consp (car defn)) |
49176059d040
(substitute-key-definition): Skip cached menu key-equivs.
Richard M. Stallman <rms@gnu.org>
parents:
7548
diff
changeset
|
353 (setq defn (cdr defn))) |
1176 | 354 (setq inner-def defn) |
355 (while (and (symbolp inner-def) | |
356 (fboundp inner-def)) | |
357 (setq inner-def (symbol-function inner-def))) | |
17215
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
358 (if (or (eq defn olddef) |
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
359 (and (or (stringp defn) (vectorp defn)) |
21e3f467224e
(substitute-key-definition):
Richard M. Stallman <rms@gnu.org>
parents:
17158
diff
changeset
|
360 (equal defn olddef))) |
6005
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
361 (define-key keymap prefix1 |
bf1c9fd5669b
(substitute-key-definition): Don't discard menu strings.
Richard M. Stallman <rms@gnu.org>
parents:
5912
diff
changeset
|
362 (nconc (nreverse skipped) newdef)) |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
363 (if (and (keymapp defn) |
13039
04ffbdd37d2d
(substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
12730
diff
changeset
|
364 (let ((elt (lookup-key keymap prefix1))) |
04ffbdd37d2d
(substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
12730
diff
changeset
|
365 (or (null elt) |
04ffbdd37d2d
(substitute-key-definition): Do recursively scan
Richard M. Stallman <rms@gnu.org>
parents:
12730
diff
changeset
|
366 (keymapp elt))) |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
367 (not (memq inner-def |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
368 key-substitution-in-progress))) |
1176 | 369 (substitute-key-definition olddef newdef keymap |
370 inner-def | |
371 prefix1))))) | |
17922
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
372 (setq i (1+ i)))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
373 (if (char-table-p (car scan)) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
374 (map-char-table |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
375 (function (lambda (char defn) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
376 (let () |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
377 ;; The inside of this let duplicates exactly |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
378 ;; the inside of the previous let, |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
379 ;; except that it uses set-char-table-range |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
380 ;; instead of define-key. |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
381 (aset vec1 0 char) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
382 (aset prefix1 (length prefix) char) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
383 (let (inner-def skipped) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
384 ;; Skip past menu-prompt. |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
385 (while (stringp (car-safe defn)) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
386 (setq skipped (cons (car defn) skipped)) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
387 (setq defn (cdr defn))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
388 (and (consp defn) (consp (car defn)) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
389 (setq defn (cdr defn))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
390 (setq inner-def defn) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
391 (while (and (symbolp inner-def) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
392 (fboundp inner-def)) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
393 (setq inner-def (symbol-function inner-def))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
394 (if (or (eq defn olddef) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
395 (and (or (stringp defn) (vectorp defn)) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
396 (equal defn olddef))) |
17943
15dc805eadee
(substitute-key-definition): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
17922
diff
changeset
|
397 (define-key keymap prefix1 |
15dc805eadee
(substitute-key-definition): Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents:
17922
diff
changeset
|
398 (nconc (nreverse skipped) newdef)) |
17922
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
399 (if (and (keymapp defn) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
400 (let ((elt (lookup-key keymap prefix1))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
401 (or (null elt) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
402 (keymapp elt))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
403 (not (memq inner-def |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
404 key-substitution-in-progress))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
405 (substitute-key-definition olddef newdef keymap |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
406 inner-def |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
407 prefix1))))))) |
29d58e05d603
(substitute-key-definition): Handle chartables.
Richard M. Stallman <rms@gnu.org>
parents:
17707
diff
changeset
|
408 (car scan))))) |
1176 | 409 (setq scan (cdr scan))))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
410 |
27821
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
411 (defun define-key-after (keymap key definition &optional after) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
412 "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
413 This is like `define-key' except that the binding for KEY is placed |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
414 just after the binding for the event AFTER, instead of at the beginning |
16556
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
415 of the map. Note that AFTER must be an event type (like KEY), NOT a command |
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
416 \(like DEFINITION). |
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
417 |
27821
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
418 If AFTER is t or omitted, the new binding goes at the end of the keymap. |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
419 AFTER should be a single event type--a symbol or a character, not a sequence. |
27821
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
420 |
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
421 Bindings are always added before any inherited map. |
16556
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
422 |
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
423 The order of bindings in a keymap matters when it is used as a menu." |
27821
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
424 (unless after (setq after t)) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
425 (or (keymapp keymap) |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
426 (signal 'wrong-type-argument (list 'keymapp keymap))) |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
427 (setq key |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
428 (if (<= (length key) 1) (aref key 0) |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
429 (setq keymap (lookup-key keymap |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
430 (apply 'vector |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
431 (butlast (mapcar 'identity key))))) |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
432 (aref key (1- (length key))))) |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
433 (let ((tail keymap) done inserted) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
434 (while (and (not done) tail) |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
435 ;; Delete any earlier bindings for the same key. |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
436 (if (eq (car-safe (car (cdr tail))) key) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
437 (setcdr tail (cdr (cdr tail)))) |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
438 ;; If we hit an included map, go down that one. |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
439 (if (keymapp (car tail)) (setq tail (car tail))) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
440 ;; When we reach AFTER's binding, insert the new binding after. |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
441 ;; If we reach an inherited keymap, insert just before that. |
3927
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
442 ;; If we reach the end of this keymap, insert at the end. |
16556
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
443 (if (or (and (eq (car-safe (car tail)) after) |
3a1df67c6677
(define-key-after): If AFTER is t, always put new binding at the end.
Richard M. Stallman <rms@gnu.org>
parents:
16549
diff
changeset
|
444 (not (eq after t))) |
3927
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
445 (eq (car (cdr tail)) 'keymap) |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
446 (null (cdr tail))) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
447 (progn |
3927
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
448 ;; Stop the scan only if we find a parent keymap. |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
449 ;; Keep going past the inserted element |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
450 ;; so we can delete any duplications that come later. |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
451 (if (eq (car (cdr tail)) 'keymap) |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
452 (setq done t)) |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
453 ;; Don't insert more than once. |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
454 (or inserted |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
455 (setcdr tail (cons (cons key definition) (cdr tail)))) |
3927
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
456 (setq inserted t))) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
457 (setq tail (cdr tail))))) |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
458 |
44251
3900f65547f0
(play-sound-file): Moved to simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
44158
diff
changeset
|
459 |
17437 | 460 (defmacro kbd (keys) |
461 "Convert KEYS to the internal Emacs key representation. | |
462 KEYS should be a string constant in the format used for | |
463 saving keyboard macros (see `insert-kbd-macro')." | |
464 (read-kbd-macro keys)) | |
465 | |
15894
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
466 (put 'keyboard-translate-table 'char-table-extra-slots 0) |
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
467 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
468 (defun keyboard-translate (from to) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
469 "Translate character FROM to TO at a low level. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
470 This function creates a `keyboard-translate-table' if necessary |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
471 and then modifies one entry in it." |
15894
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
472 (or (char-table-p keyboard-translate-table) |
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
473 (setq keyboard-translate-table |
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
474 (make-char-table 'keyboard-translate-table nil))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
475 (aset keyboard-translate-table from to)) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
476 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
477 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
478 ;;;; The global keymap tree. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
479 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
480 ;;; global-map, esc-map, and ctl-x-map have their values set up in |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
481 ;;; keymap.c; we just give them docstrings here. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
482 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
483 (defvar global-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
484 "Default global keymap mapping Emacs keyboard input into commands. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
485 The value is a keymap which is usually (but not necessarily) Emacs's |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
486 global map.") |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
487 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
488 (defvar esc-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
489 "Default keymap for ESC (meta) commands. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
490 The normal global definition of the character ESC indirects to this keymap.") |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
491 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
492 (defvar ctl-x-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
493 "Default keymap for C-x commands. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
494 The normal global definition of the character C-x indirects to this keymap.") |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
495 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
496 (defvar ctl-x-4-map (make-sparse-keymap) |
41955 | 497 "Keymap for subcommands of C-x 4.") |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
498 (defalias 'ctl-x-4-prefix ctl-x-4-map) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
499 (define-key ctl-x-map "4" 'ctl-x-4-prefix) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
500 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
501 (defvar ctl-x-5-map (make-sparse-keymap) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
502 "Keymap for frame commands.") |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
503 (defalias 'ctl-x-5-prefix ctl-x-5-map) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
504 (define-key ctl-x-map "5" 'ctl-x-5-prefix) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
505 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
506 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
507 ;;;; Event manipulation functions. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
508 |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
509 ;; The call to `read' is to ensure that the value is computed at load time |
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
510 ;; and not compiled into the .elc file. The value is negative on most |
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
511 ;; machines, but not on all! |
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
512 (defconst listify-key-sequence-1 (logior 128 (read "?\\M-\\^@"))) |
3153
4c94c9faf1af
(listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents:
2963
diff
changeset
|
513 |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
514 (defun listify-key-sequence (key) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
515 "Convert a key sequence to a list of events." |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
516 (if (vectorp key) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
517 (append key nil) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
518 (mapcar (function (lambda (c) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
519 (if (> c 127) |
3153
4c94c9faf1af
(listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents:
2963
diff
changeset
|
520 (logxor c listify-key-sequence-1) |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
521 c))) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
522 (append key nil)))) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
523 |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
524 (defsubst eventp (obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
525 "True if the argument is an event object." |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
526 (or (integerp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
527 (and (symbolp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
528 (get obj 'event-symbol-elements)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
529 (and (consp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
530 (symbolp (car obj)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
531 (get (car obj) 'event-symbol-elements)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
532 |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
533 (defun event-modifiers (event) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
534 "Returns a list of symbols representing the modifier keys in event EVENT. |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
535 The elements of the list may include `meta', `control', |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
536 `shift', `hyper', `super', `alt', `click', `double', `triple', `drag', |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
537 and `down'." |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
538 (let ((type event)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
539 (if (listp type) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
540 (setq type (car type))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
541 (if (symbolp type) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
542 (cdr (get type 'event-symbol-elements)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
543 (let ((list nil)) |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
544 (or (zerop (logand type ?\M-\^@)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
545 (setq list (cons 'meta list))) |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
546 (or (and (zerop (logand type ?\C-\^@)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
547 (>= (logand type 127) 32)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
548 (setq list (cons 'control list))) |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
549 (or (and (zerop (logand type ?\S-\^@)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
550 (= (logand type 255) (downcase (logand type 255)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
551 (setq list (cons 'shift list))) |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
552 (or (zerop (logand type ?\H-\^@)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
553 (setq list (cons 'hyper list))) |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
554 (or (zerop (logand type ?\s-\^@)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
555 (setq list (cons 'super list))) |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
556 (or (zerop (logand type ?\A-\^@)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
557 (setq list (cons 'alt list))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
558 list)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
559 |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
560 (defun event-basic-type (event) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
561 "Returns the basic type of the given event (all modifiers removed). |
36468 | 562 The value is a printing character (not upper case) or a symbol." |
3784
d2df5ca46b39
* subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
563 (if (consp event) |
d2df5ca46b39
* subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
564 (setq event (car event))) |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
565 (if (symbolp event) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
566 (car (get event 'event-symbol-elements)) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
567 (let ((base (logand event (1- (lsh 1 18))))) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
568 (downcase (if (< base 32) (logior base 64) base))))) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
569 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
570 (defsubst mouse-movement-p (object) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
571 "Return non-nil if OBJECT is a mouse movement event." |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
572 (and (consp object) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
573 (eq (car object) 'mouse-movement))) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
574 |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
575 (defsubst event-start (event) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
576 "Return the starting position of EVENT. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
577 If EVENT is a mouse press or a mouse click, this returns the location |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
578 of the event. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
579 If EVENT is a drag, this returns the drag's starting position. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
580 The return value is of the form |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
581 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
582 The `posn-' functions access elements of such lists." |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
583 (nth 1 event)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
584 |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
585 (defsubst event-end (event) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
586 "Return the ending location of EVENT. EVENT should be a click or drag event. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
587 If EVENT is a click event, this function is the same as `event-start'. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
588 The return value is of the form |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
589 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
590 The `posn-' functions access elements of such lists." |
3860
70bdc91ef161
* subr.el (event-end): Modified to account for multi-click events.
Jim Blandy <jimb@redhat.com>
parents:
3784
diff
changeset
|
591 (nth (if (consp (nth 2 event)) 2 1) event)) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
592 |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
593 (defsubst event-click-count (event) |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
594 "Return the multi-click count of EVENT, a click or drag event. |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
595 The return value is a positive integer." |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
596 (if (integerp (nth 2 event)) (nth 2 event) 1)) |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
597 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
598 (defsubst posn-window (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
599 "Return the window in POSITION. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
600 POSITION should be a list of the form |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
601 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
602 as returned by the `event-start' and `event-end' functions." |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
603 (nth 0 position)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
604 |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
605 (defsubst posn-point (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
606 "Return the buffer location in POSITION. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
607 POSITION should be a list of the form |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
608 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
609 as returned by the `event-start' and `event-end' functions." |
3991
ad2bd545983e
* subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents:
3927
diff
changeset
|
610 (if (consp (nth 1 position)) |
ad2bd545983e
* subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents:
3927
diff
changeset
|
611 (car (nth 1 position)) |
ad2bd545983e
* subr.el (posn-point): Properly extract the BUFFER-POSITION field
Jim Blandy <jimb@redhat.com>
parents:
3927
diff
changeset
|
612 (nth 1 position))) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
613 |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
614 (defsubst posn-x-y (position) |
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
615 "Return the x and y coordinates in POSITION. |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
616 POSITION should be a list of the form |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
617 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
618 as returned by the `event-start' and `event-end' functions." |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
619 (nth 2 position)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
620 |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
621 (defun posn-col-row (position) |
7693
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
622 "Return the column and row in POSITION, measured in characters. |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
623 POSITION should be a list of the form |
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
624 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
625 as returned by the `event-start' and `event-end' functions. |
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
626 For a scroll-bar event, the result column is 0, and the row |
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
627 corresponds to the vertical position of the click in the scroll bar." |
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
628 (let ((pair (nth 2 position)) |
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
629 (window (posn-window position))) |
7693
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
630 (if (eq (if (consp (nth 1 position)) |
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
631 (car (nth 1 position)) |
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
632 (nth 1 position)) |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
633 'vertical-scroll-bar) |
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
634 (cons 0 (scroll-bar-scale pair (1- (window-height window)))) |
7693
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
635 (if (eq (if (consp (nth 1 position)) |
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
636 (car (nth 1 position)) |
5fcf0620b8d3
(posn-col-row): Test for consp, not symbolp.
Karl Heuer <kwzh@gnu.org>
parents:
7640
diff
changeset
|
637 (nth 1 position)) |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
638 'horizontal-scroll-bar) |
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
639 (cons (scroll-bar-scale pair (window-width window)) 0) |
7640
9b1194796ef5
(posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents:
7636
diff
changeset
|
640 (let* ((frame (if (framep window) window (window-frame window))) |
9b1194796ef5
(posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents:
7636
diff
changeset
|
641 (x (/ (car pair) (frame-char-width frame))) |
9b1194796ef5
(posn-col-row): Use let*.
Richard M. Stallman <rms@gnu.org>
parents:
7636
diff
changeset
|
642 (y (/ (cdr pair) (frame-char-height frame)))) |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
643 (cons x y)))))) |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
644 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
645 (defsubst posn-timestamp (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
646 "Return the timestamp of POSITION. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
647 POSITION should be a list of the form |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
648 (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP) |
3411
d91b3097bb76
(posn-timestamp): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
3210
diff
changeset
|
649 as returned by the `event-start' and `event-end' functions." |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
650 (nth 3 position)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
651 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
652 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
653 ;;;; Obsolescent names for functions. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
654 |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
655 (defalias 'dot 'point) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
656 (defalias 'dot-marker 'point-marker) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
657 (defalias 'dot-min 'point-min) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
658 (defalias 'dot-max 'point-max) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
659 (defalias 'window-dot 'window-point) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
660 (defalias 'set-window-dot 'set-window-point) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
661 (defalias 'read-input 'read-string) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
662 (defalias 'send-string 'process-send-string) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
663 (defalias 'send-region 'process-send-region) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
664 (defalias 'show-buffer 'set-window-buffer) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
665 (defalias 'buffer-flush-undo 'buffer-disable-undo) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
666 (defalias 'eval-current-buffer 'eval-buffer) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
667 (defalias 'compiled-function-p 'byte-code-function-p) |
16437
0626ef653e3e
(define-function): Define as alias for defalias.
Richard M. Stallman <rms@gnu.org>
parents:
16379
diff
changeset
|
668 (defalias 'define-function 'defalias) |
114 | 669 |
23134
173e15236628
(sref): Make it an alias of aref. Make the
Kenichi Handa <handa@m17n.org>
parents:
23058
diff
changeset
|
670 (defalias 'sref 'aref) |
29354
4ed4a700358b
Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29062
diff
changeset
|
671 (make-obsolete 'sref 'aref "20.4") |
4ed4a700358b
Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29062
diff
changeset
|
672 (make-obsolete 'char-bytes "Now this function always returns 1" "20.4") |
20605 | 673 |
42266
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
674 (defun insert-string (&rest args) |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
675 "Mocklisp-compatibility insert function. |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
676 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>
parents:
42083
diff
changeset
|
677 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>
parents:
42083
diff
changeset
|
678 (dolist (el args) |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
679 (insert (if (integerp el) (number-to-string el) el)))) |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
680 |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
681 (make-obsolete 'insert-string 'insert "21.3") |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
682 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
683 ;; Some programs still use this as a function. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
684 (defun baud-rate () |
3210 | 685 "Obsolete function returning the value of the `baud-rate' variable. |
686 Please convert your programs to use the variable `baud-rate' directly." | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
687 baud-rate) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
688 |
15599
7d3af2dcd864
(unfocus-frame, focus-frame): Define as no-ops.
Miles Bader <miles@gnu.org>
parents:
14707
diff
changeset
|
689 (defalias 'focus-frame 'ignore) |
7d3af2dcd864
(unfocus-frame, focus-frame): Define as no-ops.
Miles Bader <miles@gnu.org>
parents:
14707
diff
changeset
|
690 (defalias 'unfocus-frame 'ignore) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
691 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
692 ;;;; Alternate names for functions - these are not being phased out. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
693 |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
694 (defalias 'string= 'string-equal) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
695 (defalias 'string< 'string-lessp) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
696 (defalias 'move-marker 'set-marker) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
697 (defalias 'rplaca 'setcar) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
698 (defalias 'rplacd 'setcdr) |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3411
diff
changeset
|
699 (defalias 'beep 'ding) ;preserve lingual purity |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
700 (defalias 'indent-to-column 'indent-to) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
701 (defalias 'backward-delete-char 'delete-backward-char) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
702 (defalias 'search-forward-regexp (symbol-function 're-search-forward)) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
703 (defalias 'search-backward-regexp (symbol-function 're-search-backward)) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
704 (defalias 'int-to-string 'number-to-string) |
21173
e917eb0d4e01
(save-match-data): store-match-data => set-match-data.
Richard M. Stallman <rms@gnu.org>
parents:
21092
diff
changeset
|
705 (defalias 'store-match-data 'set-match-data) |
31563
96b9757bfd45
(add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents:
30515
diff
changeset
|
706 ;; These are the XEmacs names: |
25293
fd43e1a99384
(point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents:
25140
diff
changeset
|
707 (defalias 'point-at-eol 'line-end-position) |
fd43e1a99384
(point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents:
25140
diff
changeset
|
708 (defalias 'point-at-bol 'line-beginning-position) |
1903
87f63305319f
* subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents:
1867
diff
changeset
|
709 |
87f63305319f
* subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents:
1867
diff
changeset
|
710 ;;; Should this be an obsolete name? If you decide it should, you get |
87f63305319f
* subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents:
1867
diff
changeset
|
711 ;;; to go through all the sources and change them. |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
712 (defalias 'string-to-int 'string-to-number) |
114 | 713 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
714 ;;;; Hook manipulation functions. |
388 | 715 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
716 (defun make-local-hook (hook) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
717 "Make the hook HOOK local to the current buffer. |
23786
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
718 The return value is HOOK. |
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
719 |
33707
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
720 You never need to call this function now that `add-hook' does it for you |
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
721 if its LOCAL argument is non-nil. |
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
722 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
723 When a hook is local, its local and global values |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
724 work in concert: running the hook actually runs all the hook |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
725 functions listed in *either* the local value *or* the global value |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
726 of the hook variable. |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
727 |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
728 This function works by making t a member of the buffer-local value, |
12258
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
729 which acts as a flag to run the hook functions in the default value as |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
730 well. This works for all normal hooks, but does not work for most |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
731 non-normal hooks yet. We will be changing the callers of non-normal |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
732 hooks so that they can handle localness; this has to be done one by |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
733 one. |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
734 |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
735 This function does nothing if HOOK is already local in the current |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
736 buffer. |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
737 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
738 Do not use `make-local-variable' to make a hook variable buffer-local." |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
739 (if (local-variable-p hook) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
740 nil |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
741 (or (boundp hook) (set hook nil)) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
742 (make-local-variable hook) |
23786
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
743 (set hook (list t))) |
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
744 hook) |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
745 (make-obsolete 'make-local-hook "Not necessary any more." "21.1") |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
746 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
747 (defun add-hook (hook function &optional append local) |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
748 "Add to the value of HOOK the function FUNCTION. |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
749 FUNCTION is not added if already present. |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
750 FUNCTION is added (if necessary) at the beginning of the hook list |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
751 unless the optional argument APPEND is non-nil, in which case |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
752 FUNCTION is added at the end. |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
753 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
754 The optional fourth argument, LOCAL, if non-nil, says to modify |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
755 the hook's buffer-local value rather than its default value. |
43435 | 756 This makes the hook buffer-local if needed, and it makes t a member |
757 of the buffer-local value. That acts as a flag to run the hook | |
758 functions in the default value as well as in the local value. | |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
759 |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
760 HOOK should be a symbol, and FUNCTION may be any valid function. If |
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
761 HOOK is void, it is first set to nil. If HOOK's value is a single |
8959
d33302427a47
(remove-hook, add-hook): Copy existing list before modifying.
Richard M. Stallman <rms@gnu.org>
parents:
8928
diff
changeset
|
762 function, it is changed to a list of functions." |
114 | 763 (or (boundp hook) (set hook nil)) |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
764 (or (default-boundp hook) (set-default hook nil)) |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
765 (if local (unless (local-variable-if-set-p hook) |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
766 (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>
parents:
28811
diff
changeset
|
767 ;; Detect the case where make-local-variable was used on a hook |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
768 ;; and do what we used to do. |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
769 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
770 (setq local t))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
771 (let ((hook-value (if local (symbol-value hook) (default-value hook)))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
772 ;; If the hook value is a single function, turn it into a list. |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
773 (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda)) |
28940
2a91228f7aa3
(add-hook): setq hook-value, not set
Sam Steingold <sds@gnu.org>
parents:
28868
diff
changeset
|
774 (setq hook-value (list hook-value))) |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
775 ;; Do the actual addition if necessary |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
776 (unless (member function hook-value) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
777 (setq hook-value |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
778 (if append |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
779 (append hook-value (list function)) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
780 (cons function hook-value)))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
781 ;; Set the actual variable |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
782 (if local (set hook hook-value) (set-default hook hook-value)))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
783 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
784 (defun remove-hook (hook function &optional local) |
4964
78c13f3054e5
(remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents:
4767
diff
changeset
|
785 "Remove from the value of HOOK the function FUNCTION. |
78c13f3054e5
(remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents:
4767
diff
changeset
|
786 HOOK should be a symbol, and FUNCTION may be any valid function. If |
78c13f3054e5
(remove-hook): New function, analogous to add-hook. This
Richard M. Stallman <rms@gnu.org>
parents:
4767
diff
changeset
|
787 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
788 list of hooks to run in HOOK, then nothing is done. See `add-hook'. |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
789 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
790 The optional third argument, LOCAL, if non-nil, says to modify |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
791 the hook's buffer-local value rather than its default value. |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
792 This makes the hook buffer-local if needed." |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
793 (or (boundp hook) (set hook nil)) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
794 (or (default-boundp hook) (set-default hook nil)) |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
795 (if local (unless (local-variable-if-set-p hook) |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
796 (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>
parents:
28811
diff
changeset
|
797 ;; Detect the case where make-local-variable was used on a hook |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
798 ;; and do what we used to do. |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
799 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
800 (setq local t))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
801 (let ((hook-value (if local (symbol-value hook) (default-value hook)))) |
29062
a11f776c0efc
(remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28947
diff
changeset
|
802 ;; Remove the function, for both the list and the non-list cases. |
a11f776c0efc
(remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28947
diff
changeset
|
803 (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda)) |
a11f776c0efc
(remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28947
diff
changeset
|
804 (if (equal hook-value function) (setq hook-value nil)) |
a11f776c0efc
(remove-hook): Don't turn the hook's value into a list.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28947
diff
changeset
|
805 (setq hook-value (delete function (copy-sequence hook-value)))) |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
806 ;; If the function is on the global hook, we need to shadow it locally |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
807 ;;(when (and local (member function (default-value hook)) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
808 ;; (not (member (cons 'not function) hook-value))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
809 ;; (push (cons 'not function) hook-value)) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
810 ;; Set the actual variable |
44473
b64869712ee0
(remove-hook): When there are no more local hooks,
Richard M. Stallman <rms@gnu.org>
parents:
44422
diff
changeset
|
811 (if (not local) |
b64869712ee0
(remove-hook): When there are no more local hooks,
Richard M. Stallman <rms@gnu.org>
parents:
44422
diff
changeset
|
812 (set-default hook hook-value) |
b64869712ee0
(remove-hook): When there are no more local hooks,
Richard M. Stallman <rms@gnu.org>
parents:
44422
diff
changeset
|
813 (if (equal hook-value '(t)) |
b64869712ee0
(remove-hook): When there are no more local hooks,
Richard M. Stallman <rms@gnu.org>
parents:
44422
diff
changeset
|
814 (kill-local-variable hook) |
b64869712ee0
(remove-hook): When there are no more local hooks,
Richard M. Stallman <rms@gnu.org>
parents:
44422
diff
changeset
|
815 (set hook hook-value))))) |
9510
f03544494d1c
(add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9202
diff
changeset
|
816 |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
817 (defun add-to-list (list-var element &optional append) |
9535 | 818 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. |
13812 | 819 The test for presence of ELEMENT is done with `equal'. |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
820 If ELEMENT is added, it is added at the beginning of the list, |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
821 unless the optional argument APPEND is non-nil, in which case |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
822 ELEMENT is added at the end. |
24757
f4127409d184
(add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
24699
diff
changeset
|
823 |
43833 | 824 The return value is the new value of LIST-VAR. |
825 | |
9535 | 826 If you want to use `add-to-list' on a variable that is not defined |
827 until a certain package is loaded, you should put the call to `add-to-list' | |
828 into a hook function that will be run only after loading the package. | |
829 `eval-after-load' provides one way to do this. In some cases | |
830 other hooks, such as major mode hooks, can do the job." | |
21409
3e8b7782f4f5
(add-to-list): Always return updated value of LIST-VAR.
Karl Heuer <kwzh@gnu.org>
parents:
21173
diff
changeset
|
831 (if (member element (symbol-value list-var)) |
3e8b7782f4f5
(add-to-list): Always return updated value of LIST-VAR.
Karl Heuer <kwzh@gnu.org>
parents:
21173
diff
changeset
|
832 (symbol-value list-var) |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
833 (set list-var |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
834 (if append |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
835 (append (symbol-value list-var) (list element)) |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
836 (cons element (symbol-value list-var)))))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
837 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
838 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
839 ;;; Load history |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
840 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
841 (defvar symbol-file-load-history-loaded nil |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
842 "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
843 That file records the part of `load-history' for preloaded files, |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
844 which is cleared out before dumping to make Emacs smaller.") |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
845 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
846 (defun load-symbol-file-load-history () |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
847 "Load the file `fns-VERSION.el' in `exec-directory' if not already done. |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
848 That file records the part of `load-history' for preloaded files, |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
849 which is cleared out before dumping to make Emacs smaller." |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
850 (unless symbol-file-load-history-loaded |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
851 (load (expand-file-name |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
852 ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
853 (if (eq system-type 'ms-dos) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
854 "fns.el" |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
855 (format "fns-%s.el" emacs-version)) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
856 exec-directory) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
857 ;; The file name fns-%s.el already has a .el extension. |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
858 nil nil t) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
859 (setq symbol-file-load-history-loaded t))) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
860 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
861 (defun symbol-file (function) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
862 "Return the input source from which FUNCTION was loaded. |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
863 The value is normally a string that was passed to `load': |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
864 either an absolute file name, or a library name |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
865 \(with no directory name and no `.el' or `.elc' at the end). |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
866 It can also be nil, if the definition is not associated with any file." |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
867 (load-symbol-file-load-history) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
868 (let ((files load-history) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
869 file functions) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
870 (while files |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
871 (if (memq function (cdr (car files))) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
872 (setq file (car (car files)) files nil)) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
873 (setq files (cdr files))) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
874 file)) |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
875 |
114 | 876 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
877 ;;;; Specifying things to do after certain files are loaded. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
878 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
879 (defun eval-after-load (file form) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
880 "Arrange that, if FILE is ever loaded, FORM will be run at that time. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
881 This makes or adds to an entry on `after-load-alist'. |
10794
4443f78a2117
(eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents:
10693
diff
changeset
|
882 If FILE is already loaded, evaluate FORM right now. |
5440
856ecdc5228a
(eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents:
5421
diff
changeset
|
883 It does nothing if FORM is already on the list for FILE. |
34750 | 884 FILE must match exactly. Normally FILE is the name of a library, |
885 with no directory or extension specified, since that is how `load' | |
41140
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
886 is normally called. |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
887 FILE can also be a feature (i.e. a symbol), in which case FORM is |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
888 evaluated whenever that feature is `provide'd." |
5440
856ecdc5228a
(eval-after-load): Do nothing if FORM is already on the list.
Richard M. Stallman <rms@gnu.org>
parents:
5421
diff
changeset
|
889 (let ((elt (assoc file after-load-alist))) |
41140
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
890 ;; Make sure there is an element for FILE. |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
891 (unless elt (setq elt (list file)) (push elt after-load-alist)) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
892 ;; Add FORM to the element if it isn't there. |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
893 (unless (member form (cdr elt)) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
894 (nconc elt (list form)) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
895 ;; If the file has been loaded already, run FORM right away. |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
896 (if (if (symbolp file) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
897 (featurep file) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
898 ;; Make sure `load-history' contains the files dumped with |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
899 ;; Emacs for the case that FILE is one of them. |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
900 (load-symbol-file-load-history) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
901 (assoc file load-history)) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
902 (eval form)))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
903 form) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
904 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
905 (defun eval-next-after-load (file) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
906 "Read the following input sexp, and run it whenever FILE is loaded. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
907 This makes or adds to an entry on `after-load-alist'. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
908 FILE should be the name of a library, with no directory name." |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
909 (eval-after-load file (read))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
910 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
911 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
912 ;;;; Input and display facilities. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
913 |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
914 (defvar read-quoted-char-radix 8 |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
915 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
916 Legitimate radix values are 8, 10 and 16.") |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
917 |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
918 (custom-declare-variable-early |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
919 'read-quoted-char-radix 8 |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
920 "*Radix for \\[quoted-insert] and other uses of `read-quoted-char'. |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
921 Legitimate radix values are 8, 10 and 16." |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
922 :type '(choice (const 8) (const 10) (const 16)) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
923 :group 'editing-basics) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
924 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
925 (defun read-quoted-char (&optional prompt) |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
926 "Like `read-char', but do not allow quitting. |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
927 Also, if the first character read is an octal digit, |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
928 we read any number of octal digits and return the |
21008
7111f9cf9392
(read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
20939
diff
changeset
|
929 specified character code. Any nondigit terminates the sequence. |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
930 If the terminator is RET, it is discarded; |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
931 any other terminator is used itself as input. |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
932 |
21008
7111f9cf9392
(read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
20939
diff
changeset
|
933 The optional argument PROMPT specifies a string to use to prompt the user. |
7111f9cf9392
(read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
20939
diff
changeset
|
934 The variable `read-quoted-char-radix' controls which radix to use |
7111f9cf9392
(read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
20939
diff
changeset
|
935 for numeric input." |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
936 (let ((message-log-max nil) done (first t) (code 0) char) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
937 (while (not done) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
938 (let ((inhibit-quit first) |
12108
f75e47f673f4
(read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents:
12016
diff
changeset
|
939 ;; Don't let C-h get the help message--only help function keys. |
f75e47f673f4
(read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents:
12016
diff
changeset
|
940 (help-char nil) |
f75e47f673f4
(read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents:
12016
diff
changeset
|
941 (help-form |
f75e47f673f4
(read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents:
12016
diff
changeset
|
942 "Type the special character you want to use, |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
943 or the octal character code. |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
944 RET terminates the character code and is discarded; |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
945 any other non-digit terminates the character code and is then used as input.")) |
23058
4d7992b69c29
(read-quoted-char): Don't bind input-method-function;
Richard M. Stallman <rms@gnu.org>
parents:
22960
diff
changeset
|
946 (setq char (read-event (and prompt (format "%s-" prompt)) t)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
947 (if inhibit-quit (setq quit-flag nil))) |
18948
faab6e4baa7d
(read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents:
18880
diff
changeset
|
948 ;; Translate TAB key into control-I ASCII character, and so on. |
faab6e4baa7d
(read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents:
18880
diff
changeset
|
949 (and char |
faab6e4baa7d
(read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents:
18880
diff
changeset
|
950 (let ((translated (lookup-key function-key-map (vector char)))) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
951 (if (arrayp translated) |
18948
faab6e4baa7d
(read-quoted-char): Convert function keys like Return
Richard M. Stallman <rms@gnu.org>
parents:
18880
diff
changeset
|
952 (setq char (aref translated 0))))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
953 (cond ((null char)) |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
954 ((not (integerp char)) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
955 (setq unread-command-events (list char) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
956 done t)) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
957 ((/= (logand char ?\M-\^@) 0) |
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
958 ;; Turn a meta-character into a character with the 0200 bit set. |
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
959 (setq code (logior (logand char (lognot ?\M-\^@)) 128) |
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
960 done t)) |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
961 ((and (<= ?0 char) (< char (+ ?0 (min 10 read-quoted-char-radix)))) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
962 (setq code (+ (* code read-quoted-char-radix) (- char ?0))) |
14343
ab021899d604
(read-quoted-char): Delete format call inside message.
Karl Heuer <kwzh@gnu.org>
parents:
14169
diff
changeset
|
963 (and prompt (setq prompt (message "%s %c" prompt char)))) |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
964 ((and (<= ?a (downcase char)) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
965 (< (downcase char) (+ ?a -10 (min 26 read-quoted-char-radix)))) |
19002
f21881dcd27b
(read-quoted-char): Consistently downcase letter "digits".
Richard M. Stallman <rms@gnu.org>
parents:
18948
diff
changeset
|
966 (setq code (+ (* code read-quoted-char-radix) |
f21881dcd27b
(read-quoted-char): Consistently downcase letter "digits".
Richard M. Stallman <rms@gnu.org>
parents:
18948
diff
changeset
|
967 (+ 10 (- (downcase char) ?a)))) |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
968 (and prompt (setq prompt (message "%s %c" prompt char)))) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
969 ((and (not first) (eq char ?\C-m)) |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
970 (setq done t)) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
971 ((not first) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
972 (setq unread-command-events (list char) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
973 done t)) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
974 (t (setq code char |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
975 done t))) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
976 (setq first nil)) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
977 code)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
978 |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
979 (defun read-passwd (prompt &optional confirm default) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
980 "Read a password, prompting with PROMPT. Echo `.' for each character typed. |
20472
79ea90039b23
(read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20410
diff
changeset
|
981 End with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
982 Optional argument CONFIRM, if non-nil, then read it twice to make sure. |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
983 Optional DEFAULT is a default password to use instead of empty input." |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
984 (if confirm |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
985 (let (success) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
986 (while (not success) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
987 (let ((first (read-passwd prompt nil default)) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
988 (second (read-passwd "Confirm password: " nil default))) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
989 (if (equal first second) |
36094
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
990 (progn |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
991 (and (arrayp second) (fillarray second ?\0)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
992 (setq success first)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
993 (and (arrayp first) (fillarray first ?\0)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
994 (and (arrayp second) (fillarray second ?\0)) |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
995 (message "Password not repeated accurately; please start over") |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
996 (sit-for 1)))) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
997 success) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
998 (let ((pass nil) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
999 (c 0) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1000 (echo-keystrokes 0) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1001 (cursor-in-echo-area t)) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1002 (while (progn (message "%s%s" |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1003 prompt |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1004 (make-string (length pass) ?.)) |
28628
60285ddb5d02
(read-passwd): Use read-char-exclusive.
Richard M. Stallman <rms@gnu.org>
parents:
28490
diff
changeset
|
1005 (setq c (read-char-exclusive nil t)) |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1006 (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) |
37028
f023c8a482ec
(read-passwd): Clear command history after each
Gerd Moellmann <gerd@gnu.org>
parents:
36468
diff
changeset
|
1007 (clear-this-command-keys) |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1008 (if (= c ?\C-u) |
36094
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1009 (progn |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1010 (and (arrayp pass) (fillarray pass ?\0)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1011 (setq pass "")) |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1012 (if (and (/= c ?\b) (/= c ?\177)) |
36094
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1013 (let* ((new-char (char-to-string c)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1014 (new-pass (concat pass new-char))) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1015 (and (arrayp pass) (fillarray pass ?\0)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1016 (fillarray new-char ?\0) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1017 (setq c ?\0) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1018 (setq pass new-pass)) |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1019 (if (> (length pass) 0) |
36094
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1020 (let ((new-pass (substring pass 0 -1))) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1021 (and (arrayp pass) (fillarray pass ?\0)) |
fddc05f3f926
(read-passwd): Clear Lisp memory holding password.
Gerd Moellmann <gerd@gnu.org>
parents:
35281
diff
changeset
|
1022 (setq pass new-pass)))))) |
21092
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1023 (message nil) |
7726f8d9eff0
(read-passwd): Renamed from read-password. New second arg CONFIRM.
Richard M. Stallman <rms@gnu.org>
parents:
21066
diff
changeset
|
1024 (or pass default "")))) |
20472
79ea90039b23
(read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20410
diff
changeset
|
1025 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1026 ;;; Atomic change groups. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1027 |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1028 (defmacro atomic-change-group (&rest body) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1029 "Perform BODY as an atomic change group. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1030 This means that if BODY exits abnormally, |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1031 all of its changes to the current buffer are undone. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1032 This works regadless of whether undo is enabled in the buffer. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1033 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1034 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>
parents:
42941
diff
changeset
|
1035 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>
parents:
42941
diff
changeset
|
1036 user can undo the change normally." |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1037 (let ((handle (make-symbol "--change-group-handle--")) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1038 (success (make-symbol "--change-group-success--"))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1039 `(let ((,handle (prepare-change-group)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1040 (,success nil)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1041 (unwind-protect |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1042 (progn |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1043 ;; This is inside the unwind-protect because |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1044 ;; 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>
parents:
42941
diff
changeset
|
1045 ;; to make sure that it gets disabled again. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1046 (activate-change-group ,handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1047 ,@body |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1048 (setq ,success t)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1049 ;; Either of these functions will disable undo |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1050 ;; if it was disabled before. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1051 (if ,success |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1052 (accept-change-group ,handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1053 (cancel-change-group ,handle)))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1054 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1055 (defun prepare-change-group (&optional buffer) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1056 "Return a handle for the current buffer's state, for a change group. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1057 If you specify BUFFER, make a handle for BUFFER's state instead. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1058 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1059 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>
parents:
42941
diff
changeset
|
1060 the actual changes of the change group. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1061 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1062 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>
parents:
42941
diff
changeset
|
1063 `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>
parents:
42941
diff
changeset
|
1064 `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>
parents:
42941
diff
changeset
|
1065 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>
parents:
42941
diff
changeset
|
1066 `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>
parents:
42941
diff
changeset
|
1067 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>
parents:
42941
diff
changeset
|
1068 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>
parents:
42941
diff
changeset
|
1069 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>
parents:
42941
diff
changeset
|
1070 the source code of `atomic-change-group'. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1071 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1072 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>
parents:
42941
diff
changeset
|
1073 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>
parents:
42941
diff
changeset
|
1074 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>
parents:
42941
diff
changeset
|
1075 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1076 (nconc (prepare-change-group buffer-1) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1077 (prepare-change-group buffer-2)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1078 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1079 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>
parents:
42941
diff
changeset
|
1080 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>
parents:
42941
diff
changeset
|
1081 to `accept-change-group' or `cancel-change-group'." |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1082 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1083 (list (cons (current-buffer) buffer-undo-list))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1084 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1085 (defun activate-change-group (handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1086 "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>
parents:
42941
diff
changeset
|
1087 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1088 (with-current-buffer (car elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1089 (if (eq buffer-undo-list t) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1090 (setq buffer-undo-list nil))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1091 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1092 (defun accept-change-group (handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1093 "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>
parents:
42941
diff
changeset
|
1094 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>
parents:
42941
diff
changeset
|
1095 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1096 (with-current-buffer (car elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1097 (if (eq elt t) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1098 (setq buffer-undo-list t))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1099 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1100 (defun cancel-change-group (handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1101 "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>
parents:
42941
diff
changeset
|
1102 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>
parents:
42941
diff
changeset
|
1103 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1104 (with-current-buffer (car elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1105 (setq elt (cdr elt)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1106 (let ((old-car |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1107 (if (consp elt) (car elt))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1108 (old-cdr |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1109 (if (consp elt) (cdr elt)))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1110 ;; Temporarily truncate the undo log at ELT. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1111 (when (consp elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1112 (setcar elt nil) (setcdr elt nil)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1113 (unless (eq last-command 'undo) (undo-start)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1114 ;; Make sure there's no confusion. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1115 (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>
parents:
42941
diff
changeset
|
1116 (error "Undoing to some unrelated state")) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1117 ;; Undo it all. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1118 (while pending-undo-list (undo-more 1)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1119 ;; 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>
parents:
42941
diff
changeset
|
1120 (when (consp elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1121 (setcar elt old-car) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1122 (setcdr elt old-cdr)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1123 ;; 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>
parents:
42941
diff
changeset
|
1124 (setq buffer-undo-list elt))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1125 |
44285
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
1126 ;; For compatibility. |
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
1127 (defalias 'redraw-modeline 'force-mode-line-update) |
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
1128 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1129 (defun force-mode-line-update (&optional all) |
43127
2c6477a9d9d5
(force-mode-line-update): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
43126
diff
changeset
|
1130 "Force the mode line of the current buffer to be redisplayed. |
2c6477a9d9d5
(force-mode-line-update): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
43126
diff
changeset
|
1131 With optional non-nil ALL, force redisplay of all mode lines." |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1132 (if all (save-excursion (set-buffer (other-buffer)))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1133 (set-buffer-modified-p (buffer-modified-p))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1134 |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1135 (defun momentary-string-display (string pos &optional exit-char message) |
114 | 1136 "Momentarily display STRING in the buffer at POS. |
1137 Display remains until next character is typed. | |
1138 If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed; | |
1139 otherwise it is then available as input (as a command if nothing else). | |
1140 Display MESSAGE (optional fourth arg) in the echo area. | |
1141 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." | |
1142 (or exit-char (setq exit-char ?\ )) | |
24322
ca77d79a0c21
(momentary-string-display): Bind inhibit-read-only.
Richard M. Stallman <rms@gnu.org>
parents:
24245
diff
changeset
|
1143 (let ((inhibit-read-only t) |
6553
fca6271b0983
(momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents:
6551
diff
changeset
|
1144 ;; Don't modify the undo list at all. |
fca6271b0983
(momentary-string-display): Avoid modifying the undo list.
Richard M. Stallman <rms@gnu.org>
parents:
6551
diff
changeset
|
1145 (buffer-undo-list t) |
114 | 1146 (modified (buffer-modified-p)) |
1147 (name buffer-file-name) | |
1148 insert-end) | |
1149 (unwind-protect | |
1150 (progn | |
1151 (save-excursion | |
1152 (goto-char pos) | |
1153 ;; defeat file locking... don't try this at home, kids! | |
1154 (setq buffer-file-name nil) | |
1155 (insert-before-markers string) | |
4620
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1156 (setq insert-end (point)) |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1157 ;; If the message end is off screen, recenter now. |
21173
e917eb0d4e01
(save-match-data): store-match-data => set-match-data.
Richard M. Stallman <rms@gnu.org>
parents:
21092
diff
changeset
|
1158 (if (< (window-end nil t) insert-end) |
4620
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1159 (recenter (/ (window-height) 2))) |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1160 ;; If that pushed message start off the screen, |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1161 ;; scroll to start it at the top of the screen. |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1162 (move-to-window-line 0) |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1163 (if (> (point) pos) |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1164 (progn |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1165 (goto-char pos) |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1166 (recenter 0)))) |
114 | 1167 (message (or message "Type %s to continue editing.") |
1168 (single-key-description exit-char)) | |
2033
10cdd2928c7d
(momentary-string-display): Handle any event when flushing the display.
Richard M. Stallman <rms@gnu.org>
parents:
2021
diff
changeset
|
1169 (let ((char (read-event))) |
114 | 1170 (or (eq char exit-char) |
1821
04fb1d3d6992
JimB's changes since January 18th
Jim Blandy <jimb@redhat.com>
parents:
1695
diff
changeset
|
1171 (setq unread-command-events (list char))))) |
114 | 1172 (if insert-end |
1173 (save-excursion | |
1174 (delete-region pos insert-end))) | |
1175 (setq buffer-file-name name) | |
1176 (set-buffer-modified-p modified)))) | |
1177 | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1178 |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1179 ;;;; Overlay operations |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1180 |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1181 (defun copy-overlay (o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1182 "Return a copy of overlay O." |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1183 (let ((o1 (make-overlay (overlay-start o) (overlay-end o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1184 ;; FIXME: there's no easy way to find the |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1185 ;; insertion-type of the two markers. |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1186 (overlay-buffer o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1187 (props (overlay-properties o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1188 (while props |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1189 (overlay-put o1 (pop props) (pop props))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1190 o1)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1191 |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1192 (defun remove-overlays (beg end name val) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1193 "Clear BEG and END of overlays whose property NAME has value VAL. |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1194 Overlays might be moved and or split." |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1195 (if (< end beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1196 (setq beg (prog1 end (setq end beg)))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1197 (save-excursion |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1198 (dolist (o (overlays-in beg end)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1199 (when (eq (overlay-get o name) val) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1200 ;; Either push this overlay outside beg...end |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1201 ;; or split it to exclude beg...end |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1202 ;; or delete it entirely (if it is contained in beg...end). |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1203 (if (< (overlay-start o) beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1204 (if (> (overlay-end o) end) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1205 (progn |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1206 (move-overlay (copy-overlay o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1207 (overlay-start o) beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1208 (move-overlay o end (overlay-end o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1209 (move-overlay o (overlay-start o) beg)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1210 (if (> (overlay-end o) end) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1211 (move-overlay o end (overlay-end o)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1212 (delete-overlay o))))))) |
42917
ec2db12c7670
(copy-without-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
42266
diff
changeset
|
1213 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1214 ;;;; Miscellanea. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1215 |
10254
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1216 ;; A number of major modes set this locally. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1217 ;; Give it a global value to avoid compiler warnings. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1218 (defvar font-lock-defaults nil) |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1219 |
20846
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1220 (defvar suspend-hook nil |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1221 "Normal hook run by `suspend-emacs', before suspending.") |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1222 |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1223 (defvar suspend-resume-hook nil |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1224 "Normal hook run by `suspend-emacs', after Emacs is continued.") |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1225 |
42083
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1226 (defvar temp-buffer-show-hook nil |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1227 "Normal hook run by `with-output-to-temp-buffer' after displaying the buffer. |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1228 When the hook runs, the temporary buffer is current, and the window it |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1229 was displayed in is selected. This hook is normally set up with a |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1230 function to make the buffer read only, and find function names and |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1231 variable names in it, provided the major mode is still Help mode.") |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1232 |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1233 (defvar temp-buffer-setup-hook nil |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1234 "Normal hook run by `with-output-to-temp-buffer' at the start. |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1235 When the hook runs, the temporary buffer is current. |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1236 This hook is normally set up with a function to put the buffer in Help |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1237 mode.") |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1238 |
10254
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1239 ;; Avoid compiler warnings about this variable, |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1240 ;; which has a special meaning on certain system types. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1241 (defvar buffer-file-type nil |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1242 "Non-nil if the visited file is a binary file. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1243 This variable is meaningful on MS-DOG and Windows NT. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1244 On those systems, it is automatically local in every buffer. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1245 On other systems, this variable is normally always nil.") |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1246 |
14515
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1247 ;; This should probably be written in C (i.e., without using `walk-windows'). |
14707
ddcae263bb18
Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents:
14517
diff
changeset
|
1248 (defun get-buffer-window-list (buffer &optional minibuf frame) |
14515
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1249 "Return windows currently displaying BUFFER, or nil if none. |
14707
ddcae263bb18
Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents:
14517
diff
changeset
|
1250 See `walk-windows' for the meaning of MINIBUF and FRAME." |
14517
8b88e5c2a6d5
Cope if get-buffer-window-list is given a buffer name (like get-buffer-window does).
Simon Marshall <simon@gnu.org>
parents:
14515
diff
changeset
|
1251 (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows) |
14515
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1252 (walk-windows (function (lambda (window) |
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1253 (if (eq (window-buffer window) buffer) |
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1254 (setq windows (cons window windows))))) |
14707
ddcae263bb18
Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents:
14517
diff
changeset
|
1255 minibuf frame) |
14515
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1256 windows)) |
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1257 |
8211
08fb5e917205
(ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents:
7693
diff
changeset
|
1258 (defun ignore (&rest ignore) |
08fb5e917205
(ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents:
7693
diff
changeset
|
1259 "Do nothing and return nil. |
08fb5e917205
(ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents:
7693
diff
changeset
|
1260 This function accepts any number of arguments, but ignores them." |
7400
c415ff549eed
(ignore): Allow interactive call.
Richard M. Stallman <rms@gnu.org>
parents:
7298
diff
changeset
|
1261 (interactive) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1262 nil) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1263 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1264 (defun error (&rest args) |
13936 | 1265 "Signal an error, making error message by passing all args to `format'. |
1266 In Emacs, the convention is that error messages start with a capital | |
1267 letter but *do not* end with a period. Please follow this convention | |
1268 for the sake of consistency." | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1269 (while t |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1270 (signal 'error (list (apply 'format args))))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1271 |
5912
909b94d547c4
(user-original-login-name): Reduce to a defalias, since it's redundant with
Karl Heuer <kwzh@gnu.org>
parents:
5844
diff
changeset
|
1272 (defalias 'user-original-login-name 'user-login-name) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1273 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1274 (defvar yank-excluded-properties) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1275 |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1276 (defun insert-for-yank (&rest strings) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1277 "Insert STRINGS at point, stripping some text properties. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1278 Strip text properties from the inserted text |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1279 according to `yank-excluded-properties'. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1280 Otherwise just like (insert STRINGS...)." |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1281 (let ((opoint (point))) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1282 |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1283 (apply 'insert strings) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1284 |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1285 (let ((inhibit-read-only t)) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1286 (if (eq yank-excluded-properties t) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1287 (set-text-properties opoint (point) nil) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1288 (remove-list-of-text-properties opoint (point) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1289 yank-excluded-properties))))) |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1290 |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1291 (defun insert-buffer-substring-no-properties (buf &optional start end) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1292 "Insert before point a substring of buffer BUFFER, without text properties. |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1293 BUFFER may be a buffer or a buffer name. |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1294 Arguments START and END are character numbers specifying the substring. |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1295 They default to the beginning and the end of BUFFER." |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1296 (let ((opoint (point))) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1297 (insert-buffer-substring buf start end) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1298 (let ((inhibit-read-only t)) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1299 (set-text-properties opoint (point) nil)))) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1300 |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1301 (defun insert-buffer-substring-as-yank (buf &optional start end) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1302 "Insert before point a part of buffer BUFFER, stripping some text properties. |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1303 BUFFER may be a buffer or a buffer name. Arguments START and END are |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1304 character numbers specifying the substring. They default to the |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1305 beginning and the end of BUFFER. Strip text properties from the |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1306 inserted text according to `yank-excluded-properties'." |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1307 (let ((opoint (point))) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1308 (insert-buffer-substring buf start end) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1309 (let ((inhibit-read-only t)) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1310 (if (eq yank-excluded-properties t) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1311 (set-text-properties opoint (point) nil) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1312 (remove-list-of-text-properties opoint (point) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1313 yank-excluded-properties))))) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1314 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1315 |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1316 ;; Synchronous shell commands. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1317 |
114 | 1318 (defun start-process-shell-command (name buffer &rest args) |
1319 "Start a program in a subprocess. Return the process object for it. | |
1320 Args are NAME BUFFER COMMAND &rest COMMAND-ARGS. | |
1321 NAME is name for process. It is modified if necessary to make it unique. | |
1322 BUFFER is the buffer or (buffer-name) to associate with the process. | |
1323 Process output goes at end of that buffer, unless you specify | |
1324 an output stream or filter function to handle the output. | |
1325 BUFFER may be also nil, meaning that this process is not associated | |
1326 with any buffer | |
1327 Third arg is command name, the name of a shell command. | |
1328 Remaining arguments are the arguments for the command. | |
5460
3bd42ee22d1f
(start-process-shell-command): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
5440
diff
changeset
|
1329 Wildcards and redirection are handled as usual in the shell." |
9822
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1330 (cond |
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1331 ((eq system-type 'vax-vms) |
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1332 (apply 'start-process name buffer args)) |
10025
3b058e13d177
(start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents:
9986
diff
changeset
|
1333 ;; We used to use `exec' to replace the shell with the command, |
3b058e13d177
(start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents:
9986
diff
changeset
|
1334 ;; but that failed to handle (...) and semicolon, etc. |
9822
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1335 (t |
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1336 (start-process name buffer shell-file-name shell-command-switch |
10025
3b058e13d177
(start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents:
9986
diff
changeset
|
1337 (mapconcat 'identity args " "))))) |
39598
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1338 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1339 (defun call-process-shell-command (command &optional infile buffer display |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1340 &rest args) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1341 "Execute the shell command COMMAND synchronously in separate process. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1342 The remaining arguments are optional. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1343 The program's input comes from file INFILE (nil means `/dev/null'). |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1344 Insert output in BUFFER before point; t means current buffer; |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1345 nil for BUFFER means discard it; 0 means discard and don't wait. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1346 BUFFER can also have the form (REAL-BUFFER STDERR-FILE); in that case, |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1347 REAL-BUFFER says what to do with standard output, as above, |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1348 while STDERR-FILE says what to do with standard error in the child. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1349 STDERR-FILE may be nil (discard standard error output), |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1350 t (mix it with ordinary output), or a file name string. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1351 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1352 Fourth arg DISPLAY non-nil means redisplay buffer as output is inserted. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1353 Remaining arguments are strings passed as additional arguments for COMMAND. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1354 Wildcards and redirection are handled as usual in the shell. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1355 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1356 If BUFFER is 0, `call-process-shell-command' returns immediately with value nil. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1357 Otherwise it waits for COMMAND to terminate and returns a numeric exit |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1358 status or a signal description string. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1359 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1360 (cond |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1361 ((eq system-type 'vax-vms) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1362 (apply 'call-process command infile buffer display args)) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1363 ;; We used to use `exec' to replace the shell with the command, |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1364 ;; but that failed to handle (...) and semicolon, etc. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1365 (t |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1366 (call-process shell-file-name |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1367 infile buffer display |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1368 shell-command-switch |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1369 (mapconcat 'identity (cons command args) " "))))) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
1370 |
16277
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
1371 (defmacro with-current-buffer (buffer &rest body) |
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
1372 "Execute the forms in BODY with BUFFER as the current buffer. |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1373 The value returned is the value of the last form in BODY. |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1374 See also `with-temp-buffer'." |
26002
4f46db3c9d7d
* subr.el (with-current-buffer): don't use backquotes to avoid
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
25706
diff
changeset
|
1375 (cons 'save-current-buffer |
4f46db3c9d7d
* subr.el (with-current-buffer): don't use backquotes to avoid
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
25706
diff
changeset
|
1376 (cons (list 'set-buffer buffer) |
4f46db3c9d7d
* subr.el (with-current-buffer): don't use backquotes to avoid
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
25706
diff
changeset
|
1377 body))) |
16277
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
1378 |
23736 | 1379 (defmacro with-temp-file (file &rest body) |
1380 "Create a new buffer, evaluate BODY there, and write the buffer to FILE. | |
1381 The value returned is the value of the last form in BODY. | |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1382 See also `with-temp-buffer'." |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
1383 (let ((temp-file (make-symbol "temp-file")) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1384 (temp-buffer (make-symbol "temp-buffer"))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1385 `(let ((,temp-file ,file) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1386 (,temp-buffer |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1387 (get-buffer-create (generate-new-buffer-name " *temp file*")))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1388 (unwind-protect |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1389 (prog1 |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1390 (with-current-buffer ,temp-buffer |
23736 | 1391 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1392 (with-current-buffer ,temp-buffer |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1393 (widen) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1394 (write-region (point-min) (point-max) ,temp-file nil 0))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1395 (and (buffer-name ,temp-buffer) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1396 (kill-buffer ,temp-buffer)))))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1397 |
23736 | 1398 (defmacro with-temp-message (message &rest body) |
24011 | 1399 "Display MESSAGE temporarily if non-nil while BODY is evaluated. |
23736 | 1400 The original message is restored to the echo area after BODY has finished. |
1401 The value returned is the value of the last form in BODY. | |
24011 | 1402 MESSAGE is written to the message log buffer if `message-log-max' is non-nil. |
1403 If MESSAGE is nil, the echo area and message log buffer are unchanged. | |
1404 Use a MESSAGE of \"\" to temporarily clear the echo area." | |
24000
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1405 (let ((current-message (make-symbol "current-message")) |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1406 (temp-message (make-symbol "with-temp-message"))) |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1407 `(let ((,temp-message ,message) |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1408 (,current-message)) |
23736 | 1409 (unwind-protect |
1410 (progn | |
24000
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1411 (when ,temp-message |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1412 (setq ,current-message (current-message)) |
24699
1ce8c890309e
(with-temp-message): Fix the other call to message to use %s.
Karl Heuer <kwzh@gnu.org>
parents:
24385
diff
changeset
|
1413 (message "%s" ,temp-message)) |
23736 | 1414 ,@body) |
42076
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1415 (and ,temp-message |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1416 (if ,current-message |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1417 (message "%s" ,current-message) |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1418 (message nil))))))) |
23736 | 1419 |
1420 (defmacro with-temp-buffer (&rest body) | |
1421 "Create a temporary buffer, and evaluate BODY there like `progn'. | |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1422 See also `with-temp-file' and `with-output-to-string'." |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1423 (let ((temp-buffer (make-symbol "temp-buffer"))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1424 `(let ((,temp-buffer |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1425 (get-buffer-create (generate-new-buffer-name " *temp*")))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1426 (unwind-protect |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1427 (with-current-buffer ,temp-buffer |
23736 | 1428 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1429 (and (buffer-name ,temp-buffer) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1430 (kill-buffer ,temp-buffer)))))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1431 |
16311
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1432 (defmacro with-output-to-string (&rest body) |
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1433 "Execute BODY, return the text it sent to `standard-output', as a string." |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1434 `(let ((standard-output |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1435 (get-buffer-create (generate-new-buffer-name " *string-output*")))) |
16311
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1436 (let ((standard-output standard-output)) |
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1437 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1438 (with-current-buffer standard-output |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1439 (prog1 |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1440 (buffer-string) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1441 (kill-buffer nil))))) |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1442 |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1443 (defmacro with-local-quit (&rest body) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1444 "Execute BODY with `inhibit-quit' temporarily bound to nil." |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1445 `(condition-case nil |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1446 (let ((inhibit-quit nil)) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1447 ,@body) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1448 (quit (setq quit-flag t)))) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1449 |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1450 (defmacro combine-after-change-calls (&rest body) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1451 "Execute BODY, but don't call the after-change functions till the end. |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1452 If BODY makes changes in the buffer, they are recorded |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1453 and the functions on `after-change-functions' are called several times |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1454 when BODY is finished. |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1455 The return value is the value of the last form in BODY. |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1456 |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1457 If `before-change-functions' is non-nil, then calls to the after-change |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1458 functions can't be deferred, so in that case this macro has no effect. |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1459 |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1460 Do not alter `after-change-functions' or `before-change-functions' |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1461 in BODY." |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1462 `(unwind-protect |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1463 (let ((combine-after-change-calls t)) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1464 . ,body) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1465 (combine-after-change-execute))) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1466 |
28234
763c6639628b
(combine-run-hooks): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28148
diff
changeset
|
1467 |
40282
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1468 (defvar delay-mode-hooks nil |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1469 "If non-nil, `run-mode-hooks' should delay running the hooks.") |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1470 (defvar delayed-mode-hooks nil |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1471 "List of delayed mode hooks waiting to be run.") |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1472 (make-variable-buffer-local 'delayed-mode-hooks) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1473 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1474 (defun run-mode-hooks (&rest hooks) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1475 "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS. |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1476 Execution is delayed if `delay-mode-hooks' is non-nil. |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1477 Major mode functions should use this." |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1478 (if delay-mode-hooks |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1479 ;; Delaying case. |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1480 (dolist (hook hooks) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1481 (push hook delayed-mode-hooks)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1482 ;; Normal case, just run the hook as before plus any delayed hooks. |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1483 (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1484 (setq delayed-mode-hooks nil) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1485 (apply 'run-hooks hooks))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1486 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1487 (defmacro delay-mode-hooks (&rest body) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1488 "Execute BODY, but delay any `run-mode-hooks'. |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1489 Only affects hooks run in the current buffer." |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1490 `(progn |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1491 (make-local-variable 'delay-mode-hooks) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1492 (let ((delay-mode-hooks t)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1493 ,@body))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1494 |
41975
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1495 ;; PUBLIC: find if the current mode derives from another. |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1496 |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1497 (defun derived-mode-p (&rest modes) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1498 "Non-nil if the current major mode is derived from one of MODES. |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1499 Uses the `derived-mode-parent' property of the symbol to trace backwards." |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1500 (let ((parent major-mode)) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1501 (while (and (not (memq parent modes)) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1502 (setq parent (get parent 'derived-mode-parent)))) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1503 parent)) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1504 |
27297
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1505 (defmacro with-syntax-table (table &rest body) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1506 "Evaluate BODY with syntax table of current buffer set to a copy of TABLE. |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1507 The syntax table of the current buffer is saved, BODY is evaluated, and the |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1508 saved table is restored, even in case of an abnormal exit. |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1509 Value is what BODY returns." |
27384
a10a13dd0670
(with-syntax-table): Use make-symbol, not gensym.
Richard M. Stallman <rms@gnu.org>
parents:
27383
diff
changeset
|
1510 (let ((old-table (make-symbol "table")) |
a10a13dd0670
(with-syntax-table): Use make-symbol, not gensym.
Richard M. Stallman <rms@gnu.org>
parents:
27383
diff
changeset
|
1511 (old-buffer (make-symbol "buffer"))) |
27297
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1512 `(let ((,old-table (syntax-table)) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1513 (,old-buffer (current-buffer))) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1514 (unwind-protect |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1515 (progn |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1516 (set-syntax-table (copy-syntax-table ,table)) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1517 ,@body) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1518 (save-current-buffer |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1519 (set-buffer ,old-buffer) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1520 (set-syntax-table ,old-table)))))) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1521 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1522 ;;; Matching and substitution |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1523 |
15955
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
1524 (defvar save-match-data-internal) |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
1525 |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
1526 ;; We use save-match-data-internal as the local variable because |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
1527 ;; that works ok in practice (people should not use that variable elsewhere). |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
1528 ;; We used to use an uninterned symbol; the compiler handles that properly |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
1529 ;; now, but it generates slower code. |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1530 (defmacro save-match-data (&rest body) |
43527
d51d403fd80a
(save-match-data): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
43498
diff
changeset
|
1531 "Execute the BODY forms, restoring the global value of the match data. |
d51d403fd80a
(save-match-data): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
43498
diff
changeset
|
1532 The value returned is the value of the last form in BODY." |
26084
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1533 ;; It is better not to use backquote here, |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1534 ;; because that makes a bootstrapping problem |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1535 ;; if you need to recompile all the Lisp files using interpreted code. |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1536 (list 'let |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1537 '((save-match-data-internal (match-data))) |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1538 (list 'unwind-protect |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1539 (cons 'progn body) |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
1540 '(set-match-data save-match-data-internal)))) |
144
535ec1aa78ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
114
diff
changeset
|
1541 |
11115
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents:
11101
diff
changeset
|
1542 (defun match-string (num &optional string) |
11101
67231dca5f32
Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents:
11087
diff
changeset
|
1543 "Return string of text matched by last search. |
67231dca5f32
Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents:
11087
diff
changeset
|
1544 NUM specifies which parenthesized expression in the last regexp. |
67231dca5f32
Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents:
11087
diff
changeset
|
1545 Value is nil if NUMth pair didn't match, or there were less than NUM pairs. |
67231dca5f32
Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents:
11087
diff
changeset
|
1546 Zero means the entire text matched by the whole regexp or whole string. |
67231dca5f32
Change to macro, and return nil if there was no match at the specified depth.
Simon Marshall <simon@gnu.org>
parents:
11087
diff
changeset
|
1547 STRING should be given if the last search was by `string-match' on STRING." |
11115
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents:
11101
diff
changeset
|
1548 (if (match-beginning num) |
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents:
11101
diff
changeset
|
1549 (if string |
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents:
11101
diff
changeset
|
1550 (substring string (match-beginning num) (match-end num)) |
9414f249cd8b
Changed match-string to defun, but still return nil (no error) if no match.
Simon Marshall <simon@gnu.org>
parents:
11101
diff
changeset
|
1551 (buffer-substring (match-beginning num) (match-end num))))) |
10560
fd09d51dfd77
(match-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10368
diff
changeset
|
1552 |
20491
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1553 (defun match-string-no-properties (num &optional string) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1554 "Return string of text matched by last search, without text properties. |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1555 NUM specifies which parenthesized expression in the last regexp. |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1556 Value is nil if NUMth pair didn't match, or there were less than NUM pairs. |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1557 Zero means the entire text matched by the whole regexp or whole string. |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1558 STRING should be given if the last search was by `string-match' on STRING." |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1559 (if (match-beginning num) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1560 (if string |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1561 (let ((result |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1562 (substring string (match-beginning num) (match-end num)))) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1563 (set-text-properties 0 (length result) nil result) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1564 result) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1565 (buffer-substring-no-properties (match-beginning num) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1566 (match-end num))))) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
1567 |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1568 (defun split-string (string &optional separators) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1569 "Splits STRING into substrings where there are matches for SEPARATORS. |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1570 Each match for SEPARATORS is a splitting point. |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1571 The substrings between the splitting points are made into a list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1572 which is returned. |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1573 If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\". |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1574 |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1575 If there is match for SEPARATORS at the beginning of STRING, we do not |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1576 include a null substring for that. Likewise, if there is a match |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1577 at the end of STRING, we don't include a null substring for that. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1578 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1579 Modifies the match data; use `save-match-data' if necessary." |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1580 (let ((rexp (or separators "[ \f\t\n\r\v]+")) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1581 (start 0) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1582 notfirst |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1583 (list nil)) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1584 (while (and (string-match rexp string |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1585 (if (and notfirst |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1586 (= start (match-beginning 0)) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1587 (< start (length string))) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1588 (1+ start) start)) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1589 (< (match-beginning 0) (length string))) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1590 (setq notfirst t) |
16333
585956e62c87
(split-string): Fix minor bug.
Richard M. Stallman <rms@gnu.org>
parents:
16314
diff
changeset
|
1591 (or (eq (match-beginning 0) 0) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1592 (and (eq (match-beginning 0) (match-end 0)) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
1593 (eq (match-beginning 0) start)) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1594 (setq list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1595 (cons (substring string start (match-beginning 0)) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1596 list))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1597 (setq start (match-end 0))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1598 (or (eq start (length string)) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1599 (setq list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1600 (cons (substring string start) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1601 list))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
1602 (nreverse list))) |
24089
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
1603 |
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
1604 (defun subst-char-in-string (fromchar tochar string &optional inplace) |
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
1605 "Replace FROMCHAR with TOCHAR in STRING each time it occurs. |
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
1606 Unless optional argument INPLACE is non-nil, return a new string." |
33835
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1607 (let ((i (length string)) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1608 (newstr (if inplace string (copy-sequence string)))) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1609 (while (> i 0) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1610 (setq i (1- i)) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1611 (if (eq (aref newstr i) fromchar) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1612 (aset newstr i tochar))) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
1613 newstr)) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1614 |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1615 (defun replace-regexp-in-string (regexp rep string &optional |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1616 fixedcase literal subexp start) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1617 "Replace all matches for REGEXP with REP in STRING. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1618 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1619 Return a new string containing the replacements. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1620 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1621 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1622 arguments with the same names of function `replace-match'. If START |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1623 is non-nil, start replacements at that index in STRING. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1624 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1625 REP is either a string used as the NEWTEXT arg of `replace-match' or a |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1626 function. If it is a function it is applied to each match to generate |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1627 the replacement passed to `replace-match'; the match-data at this |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1628 point are such that match 0 is the function's argument. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1629 |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1630 To replace only the first match (if any), make REGEXP match up to \\' |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1631 and replace a sub-expression, e.g. |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1632 (replace-regexp-in-string \"\\(foo\\).*\\'\" \"bar\" \" foo foo\" nil nil 1) |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1633 => \" bar foo\" |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
1634 " |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1635 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1636 ;; To avoid excessive consing from multiple matches in long strings, |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1637 ;; don't just call `replace-match' continually. Walk down the |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1638 ;; string looking for matches of REGEXP and building up a (reversed) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1639 ;; list MATCHES. This comprises segments of STRING which weren't |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1640 ;; matched interspersed with replacements for segments that were. |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
1641 ;; [For a `large' number of replacements it's more efficient to |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1642 ;; operate in a temporary buffer; we can't tell from the function's |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1643 ;; args whether to choose the buffer-based implementation, though it |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1644 ;; might be reasonable to do so for long enough STRING.] |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1645 (let ((l (length string)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1646 (start (or start 0)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1647 matches str mb me) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1648 (save-match-data |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1649 (while (and (< start l) (string-match regexp string start)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1650 (setq mb (match-beginning 0) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1651 me (match-end 0)) |
28065
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1652 ;; If we matched the empty string, make sure we advance by one char |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1653 (when (= me mb) (setq me (min l (1+ mb)))) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1654 ;; Generate a replacement for the matched substring. |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1655 ;; Operate only on the substring to minimize string consing. |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1656 ;; Set up match data for the substring for replacement; |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1657 ;; presumably this is likely to be faster than munging the |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1658 ;; match data directly in Lisp. |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1659 (string-match regexp (setq str (substring string mb me))) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1660 (setq matches |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1661 (cons (replace-match (if (stringp rep) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1662 rep |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1663 (funcall rep (match-string 0 str))) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1664 fixedcase literal str subexp) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1665 (cons (substring string start mb) ; unmatched prefix |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1666 matches))) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
1667 (setq start me)) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1668 ;; Reconstruct a string from the pieces. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1669 (setq matches (cons (substring string start l) matches)) ; leftover |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
1670 (apply #'concat (nreverse matches))))) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
1671 |
5385
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
1672 (defun shell-quote-argument (argument) |
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
1673 "Quote an argument for passing as argument to an inferior shell." |
12465
0d404ef125ea
(shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents:
12395
diff
changeset
|
1674 (if (eq system-type 'ms-dos) |
25706
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1675 ;; Quote using double quotes, but escape any existing quotes in |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1676 ;; the argument with backslashes. |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1677 (let ((result "") |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1678 (start 0) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1679 end) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1680 (if (or (null (string-match "[^\"]" argument)) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1681 (< (match-end 0) (length argument))) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1682 (while (string-match "[\"]" argument start) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1683 (setq end (match-beginning 0) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1684 result (concat result (substring argument start end) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1685 "\\" (substring argument end (1+ end))) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1686 start (1+ end)))) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
1687 (concat "\"" result (substring argument start) "\"")) |
12465
0d404ef125ea
(shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents:
12395
diff
changeset
|
1688 (if (eq system-type 'windows-nt) |
0d404ef125ea
(shell-quote-argument): Don't do anything, on MS-DOS.
Richard M. Stallman <rms@gnu.org>
parents:
12395
diff
changeset
|
1689 (concat "\"" argument "\"") |
17610
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1690 (if (equal argument "") |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1691 "''" |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1692 ;; Quote everything except POSIX filename characters. |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1693 ;; This should be safe enough even for really weird shells. |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1694 (let ((result "") (start 0) end) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1695 (while (string-match "[^-0-9a-zA-Z_./]" argument start) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1696 (setq end (match-beginning 0) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1697 result (concat result (substring argument start end) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1698 "\\" (substring argument end (1+ end))) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1699 start (1+ end))) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
1700 (concat result (substring argument start))))))) |
5385
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
1701 |
5844
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents:
5460
diff
changeset
|
1702 (defun make-syntax-table (&optional oldtable) |
5421
a248a39fa4b8
(make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents:
5385
diff
changeset
|
1703 "Return a new syntax table. |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1704 Create a syntax table which inherits from OLDTABLE (if non-nil) or |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1705 from `standard-syntax-table' otherwise." |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1706 (let ((table (make-char-table 'syntax-table nil))) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1707 (set-char-table-parent table (or oldtable (standard-syntax-table))) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1708 table)) |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1709 |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1710 (defun add-to-invisibility-spec (arg) |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1711 "Add elements to `buffer-invisibility-spec'. |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1712 See documentation for `buffer-invisibility-spec' for the kind of elements |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1713 that can be added." |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1714 (cond |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1715 ((or (null buffer-invisibility-spec) (eq buffer-invisibility-spec t)) |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1716 (setq buffer-invisibility-spec (list arg))) |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1717 (t |
17158
f181580c182c
(when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents:
17152
diff
changeset
|
1718 (setq buffer-invisibility-spec |
f181580c182c
(when, unless): Symbol props moved from cl.el.
Karl Heuer <kwzh@gnu.org>
parents:
17152
diff
changeset
|
1719 (cons arg buffer-invisibility-spec))))) |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1720 |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1721 (defun remove-from-invisibility-spec (arg) |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1722 "Remove elements from `buffer-invisibility-spec'." |
24245
418feab1639c
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
24089
diff
changeset
|
1723 (if (consp buffer-invisibility-spec) |
17152 | 1724 (setq buffer-invisibility-spec (delete arg buffer-invisibility-spec)))) |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1725 |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1726 (defun global-set-key (key command) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1727 "Give KEY a global binding as COMMAND. |
20410
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1728 COMMAND is the command definition to use; usually it is |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1729 a symbol naming an interactively-callable function. |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1730 KEY is a key sequence; noninteractively, it is a string or vector |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1731 of characters or event types, and non-ASCII characters with codes |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1732 above 127 (such as ISO Latin-1) can be included if you use a vector. |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1733 |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1734 Note that if KEY has a local binding in the current buffer, |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1735 that local binding will continue to shadow any global binding |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1736 that you make with this function." |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1737 (interactive "KSet key globally: \nCSet key %s to command: ") |
43498
ecd03935bb98
(global-set-key, local-set-key): Undo 2002-02-06
Kim F. Storm <storm@cua.dk>
parents:
43435
diff
changeset
|
1738 (or (vectorp key) (stringp key) |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1739 (signal 'wrong-type-argument (list 'arrayp key))) |
21578
6175866e1b71
(local-set-key, global-set-key): Return what define-key returns.
Richard M. Stallman <rms@gnu.org>
parents:
21409
diff
changeset
|
1740 (define-key (current-global-map) key command)) |
5421
a248a39fa4b8
(make-syntax-table): New function; no longer an alias
Richard M. Stallman <rms@gnu.org>
parents:
5385
diff
changeset
|
1741 |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1742 (defun local-set-key (key command) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1743 "Give KEY a local binding as COMMAND. |
20410
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1744 COMMAND is the command definition to use; usually it is |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1745 a symbol naming an interactively-callable function. |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1746 KEY is a key sequence; noninteractively, it is a string or vector |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1747 of characters or event types, and non-ASCII characters with codes |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1748 above 127 (such as ISO Latin-1) can be included if you use a vector. |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
1749 |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1750 The binding goes in the current buffer's local map, |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1751 which in most cases is shared with all other buffers in the same major mode." |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1752 (interactive "KSet key locally: \nCSet key %s locally to command: ") |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1753 (let ((map (current-local-map))) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1754 (or map |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1755 (use-local-map (setq map (make-sparse-keymap)))) |
43498
ecd03935bb98
(global-set-key, local-set-key): Undo 2002-02-06
Kim F. Storm <storm@cua.dk>
parents:
43435
diff
changeset
|
1756 (or (vectorp key) (stringp key) |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1757 (signal 'wrong-type-argument (list 'arrayp key))) |
21578
6175866e1b71
(local-set-key, global-set-key): Return what define-key returns.
Richard M. Stallman <rms@gnu.org>
parents:
21409
diff
changeset
|
1758 (define-key map key command))) |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1759 |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1760 (defun global-unset-key (key) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1761 "Remove global binding of KEY. |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1762 KEY is a string representing a sequence of keystrokes." |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1763 (interactive "kUnset key globally: ") |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1764 (global-set-key key nil)) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1765 |
10826
bd0ab0601489
(local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents:
10825
diff
changeset
|
1766 (defun local-unset-key (key) |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1767 "Remove local binding of KEY. |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1768 KEY is a string representing a sequence of keystrokes." |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1769 (interactive "kUnset key locally: ") |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1770 (if (current-local-map) |
10826
bd0ab0601489
(local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents:
10825
diff
changeset
|
1771 (local-set-key key nil)) |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1772 nil) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
1773 |
12016
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1774 ;; We put this here instead of in frame.el so that it's defined even on |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1775 ;; systems where frame.el isn't loaded. |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1776 (defun frame-configuration-p (object) |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1777 "Return non-nil if OBJECT seems to be a frame configuration. |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1778 Any list whose car is `frame-configuration' is assumed to be a frame |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1779 configuration." |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1780 (and (consp object) |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1781 (eq (car object) 'frame-configuration))) |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
1782 |
17418
726a87ac1486
(functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17215
diff
changeset
|
1783 (defun functionp (object) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1784 "Non-nil iff OBJECT is a type of object that can be called as a function." |
41140
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
1785 (or (and (symbolp object) (fboundp object) |
40830
576a1771ec55
(functionp): Make work correctly for macros and unbound symbols.
Miles Bader <miles@gnu.org>
parents:
40822
diff
changeset
|
1786 (setq object (indirect-function object)) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1787 (eq (car-safe object) 'autoload) |
41187
f3b21013637a
(functionp): Do use cdr-safe on object.
Richard M. Stallman <rms@gnu.org>
parents:
41140
diff
changeset
|
1788 (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object))))))) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1789 (subrp object) (byte-code-function-p object) |
40832
33d8d61c63dd
(functionp): Don't consider macros as functions.
Miles Bader <miles@gnu.org>
parents:
40830
diff
changeset
|
1790 (eq (car-safe object) 'lambda))) |
17418
726a87ac1486
(functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17215
diff
changeset
|
1791 |
37054
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1792 (defun interactive-form (function) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1793 "Return the interactive form of FUNCTION. |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1794 If function is a command (see `commandp'), value is a list of the form |
37055 | 1795 \(interactive SPEC). If function is not a command, return nil." |
37054
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1796 (setq function (indirect-function function)) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1797 (when (commandp function) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1798 (cond ((byte-code-function-p function) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1799 (when (> (length function) 5) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1800 (let ((spec (aref function 5))) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1801 (if spec |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1802 (list 'interactive spec) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1803 (list 'interactive))))) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1804 ((subrp function) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1805 (subr-interactive-form function)) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1806 ((eq (car-safe function) 'lambda) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1807 (setq function (cddr function)) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1808 (when (stringp (car function)) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1809 (setq function (cdr function))) |
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1810 (let ((form (car function))) |
37070
838adca2d2fd
(interactive-form): Fix paren typo.
Miles Bader <miles@gnu.org>
parents:
37055
diff
changeset
|
1811 (when (eq (car-safe form) 'interactive) |
37054
dec182bcbaa4
(interactive-form): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
37028
diff
changeset
|
1812 (copy-sequence form))))))) |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
1813 |
27908
1c1e1ebca7f8
(assq-delete-all): Renamed from assoc-delete-all.
Gerd Moellmann <gerd@gnu.org>
parents:
27821
diff
changeset
|
1814 (defun assq-delete-all (key alist) |
25140
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1815 "Delete from ALIST all elements whose car is KEY. |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1816 Return the modified alist." |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1817 (let ((tail alist)) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1818 (while tail |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1819 (if (eq (car (car tail)) key) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1820 (setq alist (delq (car tail) alist))) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1821 (setq tail (cdr tail))) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1822 alist)) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
1823 |
25631
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1824 (defun make-temp-file (prefix &optional dir-flag) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1825 "Create a temporary file. |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1826 The returned file name (created by appending some random characters at the end |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1827 of PREFIX, and expanding against `temporary-file-directory' if necessary, |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1828 is guaranteed to point to a newly created empty file. |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1829 You can then use `write-region' to write new data into the file. |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1830 |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1831 If DIR-FLAG is non-nil, create a new empty directory instead of a file." |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1832 (let (file) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1833 (while (condition-case () |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1834 (progn |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1835 (setq file |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1836 (make-temp-name |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1837 (expand-file-name prefix temporary-file-directory))) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1838 (if dir-flag |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1839 (make-directory file) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1840 (write-region "" nil file nil 'silent nil 'excl)) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1841 nil) |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
1842 (file-already-exists t)) |
25631
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1843 ;; the file was somehow created by someone else between |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1844 ;; `make-temp-name' and `write-region', let's try again. |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1845 nil) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1846 file)) |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
1847 |
28720
f8379b011476
(add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28628
diff
changeset
|
1848 |
28751 | 1849 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) |
28720
f8379b011476
(add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28628
diff
changeset
|
1850 "Register a new minor mode. |
28751 | 1851 |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1852 This is an XEmacs-compatibility function. Use `define-minor-mode' instead. |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1853 |
28751 | 1854 TOGGLE is a symbol which is the name of a buffer-local variable that |
1855 is toggled on or off to say whether the minor mode is active or not. | |
1856 | |
1857 NAME specifies what will appear in the mode line when the minor mode | |
1858 is active. NAME should be either a string starting with a space, or a | |
1859 symbol whose value is such a string. | |
1860 | |
1861 Optional KEYMAP is the keymap for the minor mode that will be added | |
1862 to `minor-mode-map-alist'. | |
1863 | |
1864 Optional AFTER specifies that TOGGLE should be added after AFTER | |
1865 in `minor-mode-alist'. | |
1866 | |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1867 Optional TOGGLE-FUN is an interactive function to toggle the mode. |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1868 It defaults to (and should by convention be) TOGGLE. |
31563
96b9757bfd45
(add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents:
30515
diff
changeset
|
1869 |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1870 If TOGGLE has a non-nil `:included' property, an entry for the mode is |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1871 included in the mode-line minor mode menu. |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1872 If TOGGLE has a `:menu-tag', that is used for the menu item's label." |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1873 (unless toggle-fun (setq toggle-fun toggle)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1874 ;; Add the name to the minor-mode-alist. |
28751 | 1875 (when name |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1876 (let ((existing (assq toggle minor-mode-alist))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1877 (when (and (stringp name) (not (get-text-property 0 'local-map name))) |
31563
96b9757bfd45
(add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents:
30515
diff
changeset
|
1878 (setq name |
38760
ad2af6022ebb
(add-minor-mode): Use mode-line-minor-mode-keymap for
Gerd Moellmann <gerd@gnu.org>
parents:
38414
diff
changeset
|
1879 (propertize name |
ad2af6022ebb
(add-minor-mode): Use mode-line-minor-mode-keymap for
Gerd Moellmann <gerd@gnu.org>
parents:
38414
diff
changeset
|
1880 'local-map mode-line-minor-mode-keymap |
ad2af6022ebb
(add-minor-mode): Use mode-line-minor-mode-keymap for
Gerd Moellmann <gerd@gnu.org>
parents:
38414
diff
changeset
|
1881 'help-echo "mouse-3: minor mode menu"))) |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1882 (if existing |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1883 (setcdr existing (list name)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1884 (let ((tail minor-mode-alist) found) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1885 (while (and tail (not found)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1886 (if (eq after (caar tail)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1887 (setq found tail) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1888 (setq tail (cdr tail)))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1889 (if found |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1890 (let ((rest (cdr found))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1891 (setcdr found nil) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1892 (nconc found (list (list toggle name)) rest)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1893 (setq minor-mode-alist (cons (list toggle name) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1894 minor-mode-alist))))))) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1895 ;; Add the toggle to the minor-modes menu if requested. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1896 (when (get toggle :included) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1897 (define-key mode-line-mode-menu |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1898 (vector toggle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1899 (list 'menu-item |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1900 (concat |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1901 (or (get toggle :menu-tag) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1902 (if (stringp name) name (symbol-name toggle))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1903 (let ((mode-name (if (stringp name) name |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1904 (if (symbolp name) (symbol-value name))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1905 (if mode-name |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1906 (concat " (" mode-name ")")))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1907 toggle-fun |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1908 :button (cons :toggle toggle)))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1909 |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1910 ;; Add the map to the minor-mode-map-alist. |
28751 | 1911 (when keymap |
1912 (let ((existing (assq toggle minor-mode-map-alist))) | |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1913 (if existing |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1914 (setcdr existing keymap) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1915 (let ((tail minor-mode-map-alist) found) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1916 (while (and tail (not found)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1917 (if (eq after (caar tail)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1918 (setq found tail) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1919 (setq tail (cdr tail)))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1920 (if found |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1921 (let ((rest (cdr found))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1922 (setcdr found nil) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1923 (nconc found (list (cons toggle keymap)) rest)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1924 (setq minor-mode-map-alist (cons (cons toggle keymap) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
1925 minor-mode-map-alist)))))))) |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1926 |
40282
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1927 ;; Clones ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1928 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1929 (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>
parents:
39725
diff
changeset
|
1930 "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>
parents:
39725
diff
changeset
|
1931 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>
parents:
39725
diff
changeset
|
1932 (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>
parents:
39725
diff
changeset
|
1933 (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>
parents:
39725
diff
changeset
|
1934 (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>
parents:
39725
diff
changeset
|
1935 (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>
parents:
39725
diff
changeset
|
1936 (when (<= beg end) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1937 (save-excursion |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1938 (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>
parents:
39725
diff
changeset
|
1939 ;; 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>
parents:
39725
diff
changeset
|
1940 (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>
parents:
39725
diff
changeset
|
1941 (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>
parents:
39725
diff
changeset
|
1942 (goto-char cbeg) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1943 (save-match-data |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1944 (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>
parents:
39725
diff
changeset
|
1945 (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>
parents:
39725
diff
changeset
|
1946 ;; 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>
parents:
39725
diff
changeset
|
1947 (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>
parents:
39725
diff
changeset
|
1948 (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>
parents:
39725
diff
changeset
|
1949 ;; 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>
parents:
39725
diff
changeset
|
1950 (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>
parents:
39725
diff
changeset
|
1951 (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>
parents:
39725
diff
changeset
|
1952 (+ (match-end 0) margin))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1953 (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>
parents:
39725
diff
changeset
|
1954 ;; 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>
parents:
39725
diff
changeset
|
1955 (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>
parents:
39725
diff
changeset
|
1956 (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>
parents:
39725
diff
changeset
|
1957 (overlay-end ol1))))))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1958 ;; 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>
parents:
39725
diff
changeset
|
1959 (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>
parents:
39725
diff
changeset
|
1960 (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>
parents:
39725
diff
changeset
|
1961 (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>
parents:
39725
diff
changeset
|
1962 (nothing-left t) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1963 (inhibit-modification-hooks t)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1964 (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>
parents:
39725
diff
changeset
|
1965 (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>
parents:
39725
diff
changeset
|
1966 (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>
parents:
39725
diff
changeset
|
1967 (setq nothing-left nil) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1968 (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>
parents:
39725
diff
changeset
|
1969 ;;(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>
parents:
39725
diff
changeset
|
1970 (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>
parents:
39725
diff
changeset
|
1971 (unless (> mod-beg (point)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1972 (save-excursion (insert str)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1973 (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>
parents:
39725
diff
changeset
|
1974 ;;(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>
parents:
39725
diff
changeset
|
1975 )))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1976 (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>
parents:
39725
diff
changeset
|
1977 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1978 (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>
parents:
39725
diff
changeset
|
1979 "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>
parents:
39725
diff
changeset
|
1980 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>
parents:
39725
diff
changeset
|
1981 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>
parents:
39725
diff
changeset
|
1982 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1983 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>
parents:
39725
diff
changeset
|
1984 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>
parents:
39725
diff
changeset
|
1985 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>
parents:
39725
diff
changeset
|
1986 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>
parents:
39725
diff
changeset
|
1987 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>
parents:
39725
diff
changeset
|
1988 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>
parents:
39725
diff
changeset
|
1989 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>
parents:
39725
diff
changeset
|
1990 ;; 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>
parents:
39725
diff
changeset
|
1991 ;; 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>
parents:
39725
diff
changeset
|
1992 ;; (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>
parents:
39725
diff
changeset
|
1993 ;; 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>
parents:
39725
diff
changeset
|
1994 ;; 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>
parents:
39725
diff
changeset
|
1995 ;; 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>
parents:
39725
diff
changeset
|
1996 ;; `evaporate' to make sure those overlays get deleted when needed). |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1997 ;; |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
1998 (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>
parents:
39725
diff
changeset
|
1999 (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>
parents:
39725
diff
changeset
|
2000 0 1)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2001 (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>
parents:
39725
diff
changeset
|
2002 (>= pt-end (point-max)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2003 (>= start (point-max))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2004 0 1)) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2005 (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>
parents:
39725
diff
changeset
|
2006 (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>
parents:
39725
diff
changeset
|
2007 (dups (list ol1 ol2))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2008 (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>
parents:
39725
diff
changeset
|
2009 (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>
parents:
39725
diff
changeset
|
2010 (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>
parents:
39725
diff
changeset
|
2011 ;;(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>
parents:
39725
diff
changeset
|
2012 (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>
parents:
39725
diff
changeset
|
2013 (overlay-put ol1 'text-clones dups) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2014 ;; |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2015 (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>
parents:
39725
diff
changeset
|
2016 (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>
parents:
39725
diff
changeset
|
2017 (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>
parents:
39725
diff
changeset
|
2018 ;;(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>
parents:
39725
diff
changeset
|
2019 (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>
parents:
39725
diff
changeset
|
2020 (overlay-put ol2 'text-clones dups))) |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2021 |
44422
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2022 (defun play-sound (sound) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2023 "SOUND is a list of the form `(sound KEYWORD VALUE...)'. |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2024 The following keywords are recognized: |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2025 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2026 :file FILE - read sound data from FILE. If FILE isn't an |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2027 absolute file name, it is searched in `data-directory'. |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2028 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2029 :data DATA - read sound data from string DATA. |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2030 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2031 Exactly one of :file or :data must be present. |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2032 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2033 :volume VOL - set volume to VOL. VOL must an integer in the |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2034 range 0..100 or a float in the range 0..1.0. If not specified, |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2035 don't change the volume setting of the sound device. |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2036 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2037 :device DEVICE - play sound on DEVICE. If not specified, |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2038 a system-dependent default device name is used." |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2039 (unless (fboundp 'play-sound-internal) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2040 (error "This Emacs binary lacks sound support")) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2041 (play-sound-internal sound)) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2042 |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
2043 ;;; subr.el ends here |