Mercurial > emacs
annotate lisp/subr.el @ 59865:87daa7a3dc1f
*** empty log message ***
author | Stefan Monnier <monnier@iro.umontreal.ca> |
---|---|
date | Wed, 02 Feb 2005 23:32:15 +0000 |
parents | 3054e8b6e73e |
children | aac0a33f5772 3dcba0bc766b 6d92d69fae33 |
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 |
57151
5350f17d0a78
(event-basic-type): Fix mask (extend to 22bits).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57148
diff
changeset
|
3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995, 1999, 2000, 2001, 2002, 2003, |
59648
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
4 ;; 2004, 2005 Free Software Foundation, Inc. |
114 | 5 |
45078 | 6 ;; Maintainer: FSF |
7 ;; Keywords: internal | |
8 | |
114 | 9 ;; This file is part of GNU Emacs. |
10 | |
11 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 ;; it under the terms of the GNU General Public License as published by | |
707 | 13 ;; the Free Software Foundation; either version 2, or (at your option) |
114 | 14 ;; any later version. |
15 | |
16 ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 ;; GNU General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
14169 | 22 ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 ;; Boston, MA 02111-1307, USA. | |
114 | 25 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37070
diff
changeset
|
26 ;;; Commentary: |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37070
diff
changeset
|
27 |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
28 ;;; Code: |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
29 (defvar custom-declare-variable-list nil |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
30 "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
|
31 Each element of this list holds the arguments to one call to `defcustom'.") |
114 | 32 |
19662 | 33 ;; Use this, rather than defcustom, in subr.el and other files loaded |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
34 ;; before custom.el. |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
35 (defun custom-declare-variable-early (&rest arguments) |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
36 (setq custom-declare-variable-list |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
37 (cons arguments custom-declare-variable-list))) |
44129
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
38 |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
39 |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
40 (defun macro-declaration-function (macro decl) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
41 "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
|
42 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
|
43 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
|
44 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
|
45 The return value of this function is not used." |
51062
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
46 ;; We can't use `dolist' or `cadr' yet for bootstrapping reasons. |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
47 (let (d) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
48 ;; Ignore the first element of `decl' (it's always `declare'). |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
49 (while (setq decl (cdr decl)) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
50 (setq d (car decl)) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
51 (cond ((and (consp d) (eq (car d) 'indent)) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
52 (put macro 'lisp-indent-function (car (cdr d)))) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
53 ((and (consp d) (eq (car d) 'debug)) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
54 (put macro 'edebug-form-spec (car (cdr d)))) |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
55 (t |
e562b94e5f9e
(macro-declaration-function): Avoid `dolist' and `cadr'.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51051
diff
changeset
|
56 (message "Unknown declaration %s" d)))))) |
44129
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
57 |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
58 (setq macro-declaration-function 'macro-declaration-function) |
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
59 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
60 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
61 ;;;; Lisp language features. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
62 |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
63 (defalias 'not 'null) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
64 |
53197
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
65 (defmacro noreturn (form) |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
66 "Evaluates FORM, with the expectation that the evaluation will signal an error |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
67 instead of returning to its caller. If FORM does return, an error is |
53593 | 68 signalled." |
53197
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
69 `(prog1 ,form |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
70 (error "Form marked with `noreturn' did return"))) |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
71 |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
72 (defmacro 1value (form) |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
73 "Evaluates FORM, with the expectation that all the same value will be returned |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
74 from all evaluations of FORM. This is the global do-nothing |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
75 version of `1value'. There is also `testcover-1value' that |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
76 complains if FORM ever does return differing values." |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
77 form) |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
78 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
79 (defmacro lambda (&rest cdr) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
80 "Return a lambda expression. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
81 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
|
82 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
|
83 expression itself. The lambda expression may then be treated as a |
10178 | 84 function, i.e., stored as the function value of a symbol, passed to |
85 funcall or mapcar, etc. | |
86 | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
87 ARGS should take the same form as an argument list for a `defun'. |
12395 | 88 DOCSTRING is an optional documentation string. |
89 If present, it should describe how to call the function. | |
90 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
|
91 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
|
92 It may also be omitted. |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
93 BODY should be a list of Lisp expressions. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
94 |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
95 \(fn ARGS [DOCSTRING] [INTERACTIVE] BODY)" |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
96 ;; 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
|
97 ;; depend on backquote.el. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
98 (list 'function (cons 'lambda cdr))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
99 |
25437 | 100 (defmacro push (newelt listname) |
25580 | 101 "Add NEWELT to the list stored in the symbol LISTNAME. |
25437 | 102 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
|
103 LISTNAME must be a symbol." |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
104 (declare (debug (form sexp))) |
25469 | 105 (list 'setq listname |
106 (list 'cons newelt listname))) | |
25436
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
107 |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
108 (defmacro pop (listname) |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
109 "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
|
110 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
|
111 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
|
112 change the list." |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
113 (declare (debug (sexp))) |
45823
7ec7fff5e571
(pop): Move the call to `car' outside the prog1, as the compiler
Miles Bader <miles@gnu.org>
parents:
45821
diff
changeset
|
114 (list 'car |
7ec7fff5e571
(pop): Move the call to `car' outside the prog1, as the compiler
Miles Bader <miles@gnu.org>
parents:
45821
diff
changeset
|
115 (list 'prog1 listname |
7ec7fff5e571
(pop): Move the call to `car' outside the prog1, as the compiler
Miles Bader <miles@gnu.org>
parents:
45821
diff
changeset
|
116 (list 'setq listname (list 'cdr listname))))) |
25436
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
117 |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
118 (defmacro when (cond &rest body) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
119 "If COND yields non-nil, do BODY, else return nil." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
120 (declare (indent 1) (debug t)) |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
121 (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
|
122 |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
123 (defmacro unless (cond &rest body) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
124 "If COND yields nil, do BODY, else return nil." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
125 (declare (indent 1) (debug t)) |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
126 (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
|
127 |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
128 (defmacro dolist (spec &rest body) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
129 "Loop over a list. |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
130 Evaluate BODY with VAR bound to each car from LIST, in turn. |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
131 Then evaluate RESULT to get return value, default nil. |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
132 |
51817
5e9d88e4fcff
(dolist, dotimes): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
51695
diff
changeset
|
133 \(fn (VAR LIST [RESULT]) BODY...)" |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
134 (declare (indent 1) (debug ((symbolp form &optional form) body))) |
27383
b1b3e778f7ac
Make the definitions of dolist and dotimes work
Richard M. Stallman <rms@gnu.org>
parents:
27376
diff
changeset
|
135 (let ((temp (make-symbol "--dolist-temp--"))) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
136 `(let ((,temp ,(nth 1 spec)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
137 ,(car spec)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
138 (while ,temp |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
139 (setq ,(car spec) (car ,temp)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
140 (setq ,temp (cdr ,temp)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
141 ,@body) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
142 ,@(if (cdr (cdr spec)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
143 `((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
|
144 |
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
145 (defmacro dotimes (spec &rest body) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
146 "Loop a certain number of times. |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
147 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
|
148 inclusive, to COUNT, exclusive. Then evaluate RESULT to get |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
149 the return value (nil if RESULT is omitted). |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
150 |
51817
5e9d88e4fcff
(dolist, dotimes): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
51695
diff
changeset
|
151 \(fn (VAR COUNT [RESULT]) BODY...)" |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
152 (declare (indent 1) (debug dolist)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
153 (let ((temp (make-symbol "--dotimes-temp--")) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
154 (start 0) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
155 (end (nth 1 spec))) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
156 `(let ((,temp ,end) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
157 (,(car spec) ,start)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
158 (while (< ,(car spec) ,temp) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
159 ,@body |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
160 (setq ,(car spec) (1+ ,(car spec)))) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
161 ,@(cdr (cdr spec))))) |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
162 |
53593 | 163 (defmacro declare (&rest specs) |
164 "Do not evaluate any arguments and return nil. | |
165 Treated as a declaration when used at the right place in a | |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
166 `defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" |
53593 | 167 nil) |
168 | |
19491
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
169 (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
|
170 "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
|
171 (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
|
172 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
173 (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
|
174 "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
|
175 (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
|
176 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
177 (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
|
178 "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
|
179 (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
|
180 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
181 (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
|
182 "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
|
183 (cdr (cdr x))) |
19492 | 184 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
185 (defun last (list &optional n) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
186 "Return the last link of LIST. Its car is the last element. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
187 If LIST is nil, return nil. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
188 If N is non-nil, return the Nth-to-last link of LIST. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
189 If N is bigger than the length of LIST, return LIST." |
19584
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
190 (if n |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
191 (let ((m 0) (p list)) |
19584
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
192 (while (consp p) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
193 (setq m (1+ m) p (cdr p))) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
194 (if (<= n 0) p |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
195 (if (< n m) (nthcdr (- m n) list) list))) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
196 (while (consp (cdr list)) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
197 (setq list (cdr list))) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
198 list)) |
22860
349fa4ee1f27
(assoc-default): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22755
diff
changeset
|
199 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
200 (defun butlast (list &optional n) |
56537
69db3634588e
(butlast, event-modifiers, event-basic-type): Doc fixes.
John Paul Wallington <jpw@pobox.com>
parents:
56402
diff
changeset
|
201 "Return a copy of LIST with the last N elements removed." |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
202 (if (and n (<= n 0)) list |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
203 (nbutlast (copy-sequence list) n))) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
204 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
205 (defun nbutlast (list &optional n) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
206 "Modifies LIST to remove the last N elements." |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
207 (let ((m (length list))) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
208 (or n (setq n 1)) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
209 (and (< n m) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
210 (progn |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
211 (if (> n 0) (setcdr (nthcdr (- (1- m) n) list) nil)) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
212 list)))) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
213 |
53626
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
214 (defun delete-dups (list) |
54016
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53994
diff
changeset
|
215 "Destructively remove `equal' duplicates from LIST. |
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53994
diff
changeset
|
216 Store the result in LIST and return it. LIST must be a proper list. |
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53994
diff
changeset
|
217 Of several `equal' occurrences of an element in LIST, the first |
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53994
diff
changeset
|
218 one is kept." |
53626
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
219 (let ((tail list)) |
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
220 (while tail |
54016
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53994
diff
changeset
|
221 (setcdr tail (delete (car tail) (cdr tail))) |
15b3e94eebd4
(delete-dups): A better implementation from Karl Heuer <kwzh@gnu.org>.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53994
diff
changeset
|
222 (setq tail (cdr tail)))) |
53626
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
223 list) |
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
224 |
50449
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
225 (defun number-sequence (from &optional to inc) |
50415
b040b4e36f5e
(number-sequence): New function.
Kenichi Handa <handa@m17n.org>
parents:
50136
diff
changeset
|
226 "Return a sequence of numbers from FROM to TO (both inclusive) as a list. |
53174
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
227 INC is the increment used between numbers in the sequence and defaults to 1. |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
228 So, the Nth element of the list is \(+ FROM \(* N INC)) where N counts from |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
229 zero. TO is only included if there is an N for which TO = FROM + N * INC. |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
230 If TO is nil or numerically equal to FROM, return \(FROM). |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
231 If INC is positive and TO is less than FROM, or INC is negative |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
232 and TO is larger than FROM, return nil. |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
233 If INC is zero and TO is neither nil nor numerically equal to |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
234 FROM, signal an error. |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
235 |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
236 This function is primarily designed for integer arguments. |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
237 Nevertheless, FROM, TO and INC can be integer or float. However, |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
238 floating point arithmetic is inexact. For instance, depending on |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
239 the machine, it may quite well happen that |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
240 \(number-sequence 0.4 0.6 0.2) returns the one element list \(0.4), |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
241 whereas \(number-sequence 0.4 0.8 0.2) returns a list with three |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
242 elements. Thus, if some of the arguments are floats and one wants |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
243 to make sure that TO is included, one may have to explicitly write |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
244 TO as \(+ FROM \(* N INC)) or use a variable whose value was |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
245 computed with this exact expression. Alternatively, you can, |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
246 of course, also replace TO with a slightly larger value |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
247 \(or a slightly more negative value if INC is negative)." |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
248 (if (or (not to) (= from to)) |
50449
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
249 (list from) |
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
250 (or inc (setq inc 1)) |
53174
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
251 (when (zerop inc) (error "The increment can not be zero")) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
252 (let (seq (n 0) (next from)) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
253 (if (> inc 0) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
254 (while (<= next to) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
255 (setq seq (cons next seq) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
256 n (1+ n) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
257 next (+ from (* n inc)))) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
258 (while (>= next to) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
259 (setq seq (cons next seq) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
260 n (1+ n) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
261 next (+ from (* n inc))))) |
50449
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
262 (nreverse seq)))) |
50415
b040b4e36f5e
(number-sequence): New function.
Kenichi Handa <handa@m17n.org>
parents:
50136
diff
changeset
|
263 |
30515
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
264 (defun remove (elt seq) |
42941 | 265 "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
|
266 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
|
267 (if (nlistp seq) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
268 ;; 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
|
269 ;; `delete' will return a new object. |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
270 (delete elt seq) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
271 (delete elt (copy-sequence seq)))) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
272 |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
273 (defun remq (elt list) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
274 "Return LIST with all occurrences of ELT removed. |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
275 The comparison is done with `eq'. Contrary to `delq', this does not use |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
276 side-effects, and the argument LIST is not modified." |
30515
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
277 (if (memq elt list) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
278 (delq elt (copy-sequence list)) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
279 list)) |
6165183bc490
(remove, remq): New functions.
Gerd Moellmann <gerd@gnu.org>
parents:
29354
diff
changeset
|
280 |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
281 (defun copy-tree (tree &optional vecp) |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
282 "Make a copy of TREE. |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
283 If TREE is a cons cell, this recursively copies both its car and its cdr. |
45740
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
284 Contrast to `copy-sequence', which copies only along the cdrs. With second |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
285 argument VECP, this copies vectors as well as conses." |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
286 (if (consp tree) |
45740
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
287 (let (result) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
288 (while (consp tree) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
289 (let ((newcar (car tree))) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
290 (if (or (consp (car tree)) (and vecp (vectorp (car tree)))) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
291 (setq newcar (copy-tree (car tree) vecp))) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
292 (push newcar result)) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
293 (setq tree (cdr tree))) |
45821
41129d3d126b
(copy-tree): Use `nconc' and `nreverse' instead of `nreconc'.
Miles Bader <miles@gnu.org>
parents:
45740
diff
changeset
|
294 (nconc (nreverse result) tree)) |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
295 (if (and vecp (vectorp tree)) |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
296 (let ((i (length (setq tree (copy-sequence tree))))) |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
297 (while (>= (setq i (1- i)) 0) |
45740
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
298 (aset tree i (copy-tree (aref tree i) vecp))) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
299 tree) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
300 tree))) |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
301 |
22959
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
302 (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
|
303 "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
|
304 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
|
305 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
|
306 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
|
307 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
|
308 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
|
309 |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
310 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
|
311 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
|
312 (let (found (tail alist) value) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
313 (while (and tail (not found)) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
314 (let ((elt (car tail))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
315 (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
|
316 (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
|
317 (setq tail (cdr tail))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
318 value)) |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
319 |
53412
a2bba9e88b95
(assoc-ignore-case, assoc-ignore-representation):
Richard M. Stallman <rms@gnu.org>
parents:
53368
diff
changeset
|
320 (make-obsolete 'assoc-ignore-case 'assoc-string) |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
321 (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
|
322 "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
|
323 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
|
324 Unibyte strings are converted to multibyte for comparison." |
53412
a2bba9e88b95
(assoc-ignore-case, assoc-ignore-representation):
Richard M. Stallman <rms@gnu.org>
parents:
53368
diff
changeset
|
325 (assoc-string key alist t)) |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
326 |
53412
a2bba9e88b95
(assoc-ignore-case, assoc-ignore-representation):
Richard M. Stallman <rms@gnu.org>
parents:
53368
diff
changeset
|
327 (make-obsolete 'assoc-ignore-representation 'assoc-string) |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
328 (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
|
329 "Like `assoc', but ignores differences in text representation. |
47916 | 330 KEY must be a string. |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
331 Unibyte strings are converted to multibyte for comparison." |
53412
a2bba9e88b95
(assoc-ignore-case, assoc-ignore-representation):
Richard M. Stallman <rms@gnu.org>
parents:
53368
diff
changeset
|
332 (assoc-string key alist nil)) |
28490
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
333 |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
334 (defun member-ignore-case (elt list) |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
335 "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
|
336 ELT must be a string. Upper-case and lower-case letters are treated as equal. |
44900
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
337 Unibyte strings are converted to multibyte for comparison. |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
338 Non-strings in LIST are ignored." |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
339 (while (and list |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
340 (not (and (stringp (car list)) |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
341 (eq t (compare-strings elt 0 nil (car list) 0 nil t))))) |
33978
9aa3fd6779f7
(member-ignore-case): Return the tail of the list who's car matches,
Miles Bader <miles@gnu.org>
parents:
33835
diff
changeset
|
342 (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
|
343 list) |
28490
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
344 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
345 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
346 ;;;; Keymap support. |
114 | 347 |
348 (defun undefined () | |
349 (interactive) | |
350 (ding)) | |
351 | |
352 ;Prevent the \{...} documentation construct | |
353 ;from mentioning keys that run this command. | |
354 (put 'undefined 'suppress-keymap t) | |
355 | |
356 (defun suppress-keymap (map &optional nodigits) | |
357 "Make MAP override all normally self-inserting keys to be undefined. | |
358 Normally, as an exception, digits and minus-sign are set to make prefix args, | |
359 but optional second arg NODIGITS non-nil treats them like other chars." | |
47042
74f8b41068e0
(suppress-keymap): Use command remapping instead of
Kim F. Storm <storm@cua.dk>
parents:
47025
diff
changeset
|
360 (define-key map [remap self-insert-command] 'undefined) |
114 | 361 (or nodigits |
362 (let (loop) | |
363 (define-key map "-" 'negative-argument) | |
364 ;; Make plain numbers do numeric args. | |
365 (setq loop ?0) | |
366 (while (<= loop ?9) | |
367 (define-key map (char-to-string loop) 'digit-argument) | |
368 (setq loop (1+ loop)))))) | |
369 | |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
370 (defvar key-substitution-in-progress nil |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
371 "Used internally by substitute-key-definition.") |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
372 |
1176 | 373 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) |
114 | 374 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. |
375 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
|
376 Alternatively, if optional fourth argument OLDMAP is specified, we redefine |
57438
0326440c511a
(substitute-key-definition): Mention command remapping in doc string.
Kim F. Storm <storm@cua.dk>
parents:
57408
diff
changeset
|
377 in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. |
0326440c511a
(substitute-key-definition): Mention command remapping in doc string.
Kim F. Storm <storm@cua.dk>
parents:
57408
diff
changeset
|
378 |
0326440c511a
(substitute-key-definition): Mention command remapping in doc string.
Kim F. Storm <storm@cua.dk>
parents:
57408
diff
changeset
|
379 For most uses, it is simpler and safer to use command remappping like this: |
0326440c511a
(substitute-key-definition): Mention command remapping in doc string.
Kim F. Storm <storm@cua.dk>
parents:
57408
diff
changeset
|
380 \(define-key KEYMAP [remap OLDDEF] NEWDEF)" |
28868
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
381 ;; 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
|
382 ;; 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
|
383 ;; meaning |
47916 | 384 |
28868
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
385 ;; 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
|
386 ;; 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
|
387 ;; original key, with PREFIX added at the front. |
1176 | 388 (or prefix (setq prefix "")) |
389 (let* ((scan (or oldmap keymap)) | |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
390 (prefix1 (vconcat prefix [nil])) |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
391 (key-substitution-in-progress |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
392 (cons scan key-substitution-in-progress))) |
1176 | 393 ;; Scan OLDMAP, finding each char or event-symbol that |
394 ;; has any definition, and act on it with hack-key. | |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
395 (map-keymap |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
396 (lambda (char defn) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
397 (aset prefix1 (length prefix) char) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
398 (substitute-key-definition-key defn olddef newdef prefix1 keymap)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
399 scan))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
400 |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
401 (defun substitute-key-definition-key (defn olddef newdef prefix keymap) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
402 (let (inner-def skipped menu-item) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
403 ;; Find the actual command name within the binding. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
404 (if (eq (car-safe defn) 'menu-item) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
405 (setq menu-item defn defn (nth 2 defn)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
406 ;; Skip past menu-prompt. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
407 (while (stringp (car-safe defn)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
408 (push (pop defn) skipped)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
409 ;; Skip past cached key-equivalence data for menu items. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
410 (if (consp (car-safe defn)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
411 (setq defn (cdr defn)))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
412 (if (or (eq defn olddef) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
413 ;; Compare with equal if definition is a key sequence. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
414 ;; That is useful for operating on function-key-map. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
415 (and (or (stringp defn) (vectorp defn)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
416 (equal defn olddef))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
417 (define-key keymap prefix |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
418 (if menu-item |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
419 (let ((copy (copy-sequence menu-item))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
420 (setcar (nthcdr 2 copy) newdef) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
421 copy) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
422 (nconc (nreverse skipped) newdef))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
423 ;; Look past a symbol that names a keymap. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
424 (setq inner-def |
58460
fbd266022300
(substitute-key-definition-key): Optimize. Don't
Kim F. Storm <storm@cua.dk>
parents:
58416
diff
changeset
|
425 (and defn |
fbd266022300
(substitute-key-definition-key): Optimize. Don't
Kim F. Storm <storm@cua.dk>
parents:
58416
diff
changeset
|
426 (condition-case nil (indirect-function defn) (error defn)))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
427 ;; For nested keymaps, we use `inner-def' rather than `defn' so as to |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
428 ;; avoid autoloading a keymap. This is mostly done to preserve the |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
429 ;; original non-autoloading behavior of pre-map-keymap times. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
430 (if (and (keymapp inner-def) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
431 ;; Avoid recursively scanning |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
432 ;; where KEYMAP does not have a submap. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
433 (let ((elt (lookup-key keymap prefix))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
434 (or (null elt) (natnump elt) (keymapp elt))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
435 ;; Avoid recursively rescanning keymap being scanned. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
436 (not (memq inner-def key-substitution-in-progress))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
437 ;; If this one isn't being scanned already, scan it now. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
438 (substitute-key-definition olddef newdef keymap inner-def prefix))))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
439 |
27821
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
440 (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
|
441 "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
|
442 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
|
443 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
|
444 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
|
445 \(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
|
446 |
27821
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
447 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
|
448 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
|
449 |
5ef5616e8304
(define-key-after): Default AFTER to t. Doc fix.
Dave Love <fx@gnu.org>
parents:
27810
diff
changeset
|
450 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
|
451 |
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
|
452 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
|
453 (unless after (setq after t)) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
454 (or (keymapp keymap) |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
455 (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
|
456 (setq key |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
457 (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
|
458 (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
|
459 (apply 'vector |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
460 (butlast (mapcar 'identity key))))) |
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
461 (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
|
462 (let ((tail keymap) done inserted) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
463 (while (and (not done) tail) |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
464 ;; 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
|
465 (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
|
466 (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
|
467 ;; 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
|
468 (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
|
469 ;; 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
|
470 ;; 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
|
471 ;; 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
|
472 (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
|
473 (not (eq after t))) |
3927
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
474 (eq (car (cdr tail)) 'keymap) |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
475 (null (cdr tail))) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
476 (progn |
3927
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
477 ;; 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
|
478 ;; 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
|
479 ;; 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
|
480 (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
|
481 (setq done t)) |
1f1fefc400ed
(define-key-after): Delete duplicate bindings that come
Richard M. Stallman <rms@gnu.org>
parents:
3902
diff
changeset
|
482 ;; 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
|
483 (or inserted |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
484 (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
|
485 (setq inserted t))) |
3901
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
486 (setq tail (cdr tail))))) |
c78753b7eea8
(define-key-in-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
3860
diff
changeset
|
487 |
58272
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
488 (defun map-keymap-internal (function keymap &optional sort-first) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
489 "Implement `map-keymap' with sorting. |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
490 Don't call this function; it is for internal use only." |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
491 (if sort-first |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
492 (let (list) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
493 (map-keymap (lambda (a b) (push (cons a b) list)) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
494 keymap) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
495 (setq list (sort list |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
496 (lambda (a b) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
497 (setq a (car a) b (car b)) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
498 (if (integerp a) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
499 (if (integerp b) (< a b) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
500 t) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
501 (if (integerp b) t |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
502 (string< a b)))))) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
503 (dolist (p list) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
504 (funcall function (car p) (cdr p)))) |
ca2809f6625b
(map-keymap-internal): New function.
Richard M. Stallman <rms@gnu.org>
parents:
58045
diff
changeset
|
505 (map-keymap function keymap))) |
44251
3900f65547f0
(play-sound-file): Moved to simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
44158
diff
changeset
|
506 |
17437 | 507 (defmacro kbd (keys) |
508 "Convert KEYS to the internal Emacs key representation. | |
509 KEYS should be a string constant in the format used for | |
56636 | 510 saving keyboard macros (see `edmacro-mode')." |
17437 | 511 (read-kbd-macro keys)) |
512 | |
15894
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
513 (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
|
514 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
515 (defun keyboard-translate (from to) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
516 "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
|
517 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
|
518 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
|
519 (or (char-table-p keyboard-translate-table) |
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
520 (setq keyboard-translate-table |
efd2835a7c96
(keyboard-translate): Use a char-table.
Richard M. Stallman <rms@gnu.org>
parents:
15599
diff
changeset
|
521 (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
|
522 (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
|
523 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
524 |
47916 | 525 ;;;; The global keymap tree. |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
526 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
527 ;;; 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
|
528 ;;; 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
|
529 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
530 (defvar global-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
531 "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
|
532 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
|
533 global map.") |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
534 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
535 (defvar esc-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
536 "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
|
537 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
|
538 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
539 (defvar ctl-x-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
540 "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
|
541 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
|
542 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
543 (defvar ctl-x-4-map (make-sparse-keymap) |
41955 | 544 "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
|
545 (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
|
546 (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
|
547 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
548 (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
|
549 "Keymap for frame commands.") |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
550 (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
|
551 (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
|
552 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
553 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
554 ;;;; Event manipulation functions. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
555 |
10693
0875851842f0
(listify-key-sequence-1, event-modifiers): Don't presume internal bit layout
Karl Heuer <kwzh@gnu.org>
parents:
10681
diff
changeset
|
556 ;; 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
|
557 ;; 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
|
558 ;; 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
|
559 (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
|
560 |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
561 (defun listify-key-sequence (key) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
562 "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
|
563 (if (vectorp key) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
564 (append key nil) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
565 (mapcar (function (lambda (c) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
566 (if (> c 127) |
3153
4c94c9faf1af
(listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents:
2963
diff
changeset
|
567 (logxor c listify-key-sequence-1) |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
568 c))) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
569 key))) |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
570 |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
571 (defsubst eventp (obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
572 "True if the argument is an event object." |
55520
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
573 (or (and (integerp obj) |
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
574 ;; Filter out integers too large to be events. |
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
575 ;; M is the biggest modifier. |
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
576 (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1))))) |
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
577 (char-valid-p (event-basic-type obj))) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
578 (and (symbolp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
579 (get obj 'event-symbol-elements)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
580 (and (consp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
581 (symbolp (car obj)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
582 (get (car obj) 'event-symbol-elements)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
583 |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
584 (defun event-modifiers (event) |
56537
69db3634588e
(butlast, event-modifiers, event-basic-type): Doc fixes.
John Paul Wallington <jpw@pobox.com>
parents:
56402
diff
changeset
|
585 "Return a list of symbols representing the modifier keys in event EVENT. |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
586 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
|
587 `shift', `hyper', `super', `alt', `click', `double', `triple', `drag', |
56570
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
588 and `down'. |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
589 EVENT may be an event or an event type. If EVENT is a symbol |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
590 that has never been used in an event that has been read as input |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
591 in the current Emacs session, then this function can return nil, |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
592 even when EVENT actually has modifiers." |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
593 (let ((type event)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
594 (if (listp type) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
595 (setq type (car type))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
596 (if (symbolp type) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
597 (cdr (get type 'event-symbol-elements)) |
55013
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
598 (let ((list nil) |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
599 (char (logand type (lognot (logior ?\M-\^@ ?\C-\^@ ?\S-\^@ |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
600 ?\H-\^@ ?\s-\^@ ?\A-\^@))))) |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
601 (if (not (zerop (logand type ?\M-\^@))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
602 (push 'meta list)) |
55013
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
603 (if (or (not (zerop (logand type ?\C-\^@))) |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
604 (< char 32)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
605 (push 'control list)) |
55013
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
606 (if (or (not (zerop (logand type ?\S-\^@))) |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
607 (/= char (downcase char))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
608 (push '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
|
609 (or (zerop (logand type ?\H-\^@)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
610 (push '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
|
611 (or (zerop (logand type ?\s-\^@)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
612 (push '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
|
613 (or (zerop (logand type ?\A-\^@)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
614 (push 'alt list)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
615 list)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
616 |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
617 (defun event-basic-type (event) |
56537
69db3634588e
(butlast, event-modifiers, event-basic-type): Doc fixes.
John Paul Wallington <jpw@pobox.com>
parents:
56402
diff
changeset
|
618 "Return the basic type of the given event (all modifiers removed). |
56570
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
619 The value is a printing character (not upper case) or a symbol. |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
620 EVENT may be an event or an event type. If EVENT is a symbol |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
621 that has never been used in an event that has been read as input |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
622 in the current Emacs session, then this function may return nil." |
3784
d2df5ca46b39
* subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
623 (if (consp event) |
d2df5ca46b39
* subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
624 (setq event (car event))) |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
625 (if (symbolp event) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
626 (car (get event 'event-symbol-elements)) |
57151
5350f17d0a78
(event-basic-type): Fix mask (extend to 22bits).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57148
diff
changeset
|
627 (let ((base (logand event (1- ?\A-\^@)))) |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
628 (downcase (if (< base 32) (logior base 64) base))))) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
629 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
630 (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
|
631 "Return non-nil if OBJECT is a mouse movement event." |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
632 (eq (car-safe object) 'mouse-movement)) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
633 |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
634 (defsubst event-start (event) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
635 "Return the starting position of EVENT. |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
636 If EVENT is a mouse or key press or a mouse click, this returns the location |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
637 of the event. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
638 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
|
639 The return value is of the form |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
640 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
641 IMAGE (DX . DY) (WIDTH . HEIGHT)) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
642 The `posn-' functions access elements of such lists." |
45978
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
643 (if (consp event) (nth 1 event) |
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
644 (list (selected-window) (point) '(0 . 0) 0))) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
645 |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
646 (defsubst event-end (event) |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
647 "Return the ending location of EVENT. |
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
648 EVENT should be a click, drag, or key press event. |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
649 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
|
650 The return value is of the form |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
651 (WINDOW AREA-OR-POS (X . Y) TIMESTAMP OBJECT POS (COL . ROW) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
652 IMAGE (DX . DY) (WIDTH . HEIGHT)) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
653 The `posn-' functions access elements of such lists." |
45978
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
654 (if (consp event) (nth (if (consp (nth 2 event)) 2 1) event) |
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
655 (list (selected-window) (point) '(0 . 0) 0))) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
656 |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
657 (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
|
658 "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
|
659 The return value is a positive integer." |
45978
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
660 (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1)) |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
661 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
662 (defsubst posn-window (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
663 "Return the window in POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
664 POSITION should be a list of the form returned by the `event-start' |
53593 | 665 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
|
666 (nth 0 position)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
667 |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
668 (defsubst posn-area (position) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
669 "Return the window area recorded in POSITION, or nil for the text area. |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
670 POSITION should be a list of the form returned by the `event-start' |
53593 | 671 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
672 (let ((area (if (consp (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
673 (car (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
674 (nth 1 position)))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
675 (and (symbolp area) area))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
676 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
677 (defsubst posn-point (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
678 "Return the buffer location in POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
679 POSITION should be a list of the form returned by the `event-start' |
53593 | 680 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
681 (or (nth 5 position) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
682 (if (consp (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
683 (car (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
684 (nth 1 position)))) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
685 |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
686 (defun posn-set-point (position) |
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
687 "Move point to POSITION. |
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
688 Select the corresponding window as well." |
54887
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
parents:
54866
diff
changeset
|
689 (if (not (windowp (posn-window position))) |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
690 (error "Position not in text area of window")) |
54887
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
parents:
54866
diff
changeset
|
691 (select-window (posn-window position)) |
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
parents:
54866
diff
changeset
|
692 (if (numberp (posn-point position)) |
a19fbbfac280
(posn-set-point): Fix typos: parameter is `position', not `posn'.
John Paul Wallington <jpw@pobox.com>
parents:
54866
diff
changeset
|
693 (goto-char (posn-point position)))) |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
694 |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
695 (defsubst posn-x-y (position) |
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
696 "Return the x and y coordinates in POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
697 POSITION should be a list of the form returned by the `event-start' |
53593 | 698 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
|
699 (nth 2 position)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
700 |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
701 (defun posn-col-row (position) |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
702 "Return the nominal column and row in POSITION, measured in characters. |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
703 The column and row values are approximations calculated from the x |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
704 and y coordinates in POSITION and the frame's default character width |
53593 | 705 and height. |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
706 For a scroll-bar event, the result column is 0, and the row |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
707 corresponds to the vertical position of the click in the scroll bar. |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
708 POSITION should be a list of the form returned by the `event-start' |
53593 | 709 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
710 (let* ((pair (posn-x-y position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
711 (window (posn-window position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
712 (area (posn-area position))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
713 (cond |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
714 ((null window) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
715 '(0 . 0)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
716 ((eq area 'vertical-scroll-bar) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
717 (cons 0 (scroll-bar-scale pair (1- (window-height window))))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
718 ((eq area 'horizontal-scroll-bar) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
719 (cons (scroll-bar-scale pair (window-width window)) 0)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
720 (t |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
721 (let* ((frame (if (framep window) window (window-frame window))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
722 (x (/ (car pair) (frame-char-width frame))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
723 (y (/ (cdr pair) (+ (frame-char-height frame) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
724 (or (frame-parameter frame 'line-spacing) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
725 default-line-spacing |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
726 0))))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
727 (cons x y)))))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
728 |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
729 (defun posn-actual-col-row (position) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
730 "Return the actual column and row in POSITION, measured in characters. |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
731 These are the actual row number in the window and character number in that row. |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
732 Return nil if POSITION does not contain the actual position; in that case |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
733 `posn-col-row' can be used to get approximate values. |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
734 POSITION should be a list of the form returned by the `event-start' |
53593 | 735 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
736 (nth 6 position)) |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
737 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
738 (defsubst posn-timestamp (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
739 "Return the timestamp of POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
740 POSITION should be a list of the form returned by the `event-start' |
53593 | 741 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
|
742 (nth 3 position)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
743 |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
744 (defsubst posn-string (position) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
745 "Return the string object of POSITION, or nil if a buffer position. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
746 POSITION should be a list of the form returned by the `event-start' |
53593 | 747 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
748 (nth 4 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
749 |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
750 (defsubst posn-image (position) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
751 "Return the image object of POSITION, or nil if a not an image. |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
752 POSITION should be a list of the form returned by the `event-start' |
53593 | 753 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
754 (nth 7 position)) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
755 |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
756 (defsubst posn-object (position) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
757 "Return the object (image or string) of POSITION. |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
758 POSITION should be a list of the form returned by the `event-start' |
53593 | 759 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
760 (or (posn-image position) (posn-string position))) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
761 |
53181
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
762 (defsubst posn-object-x-y (position) |
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
763 "Return the x and y coordinates relative to the object of POSITION. |
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
764 POSITION should be a list of the form returned by the `event-start' |
53593 | 765 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
766 (nth 8 position)) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
767 |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
768 (defsubst posn-object-width-height (position) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
769 "Return the pixel width and height of the object of POSITION. |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
770 POSITION should be a list of the form returned by the `event-start' |
53593 | 771 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
772 (nth 9 position)) |
53181
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
773 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
774 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
775 ;;;; Obsolescent names for functions. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
776 |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
777 (defalias 'dot 'point) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
778 (defalias 'dot-marker 'point-marker) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
779 (defalias 'dot-min 'point-min) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
780 (defalias 'dot-max 'point-max) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
781 (defalias 'window-dot 'window-point) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
782 (defalias 'set-window-dot 'set-window-point) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
783 (defalias 'read-input 'read-string) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
784 (defalias 'send-string 'process-send-string) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
785 (defalias 'send-region 'process-send-region) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
786 (defalias 'show-buffer 'set-window-buffer) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
787 (defalias 'buffer-flush-undo 'buffer-disable-undo) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
788 (defalias 'eval-current-buffer 'eval-buffer) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
789 (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
|
790 (defalias 'define-function 'defalias) |
114 | 791 |
23134
173e15236628
(sref): Make it an alias of aref. Make the
Kenichi Handa <handa@m17n.org>
parents:
23058
diff
changeset
|
792 (defalias 'sref 'aref) |
29354
4ed4a700358b
Update calls to make-obsolete with a WHEN argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
29062
diff
changeset
|
793 (make-obsolete 'sref 'aref "20.4") |
47652
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
794 (make-obsolete 'char-bytes "now always returns 1." "20.4") |
46148
a123dda5650e
(chars-in-region): Add obsolescence declaration for `chars-in-region'.
Juanma Barranquero <lekktu@gmail.com>
parents:
46052
diff
changeset
|
795 (make-obsolete 'chars-in-region "use (abs (- BEG END))." "20.3") |
46532
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
796 (make-obsolete 'dot 'point "before 19.15") |
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
797 (make-obsolete 'dot-max 'point-max "before 19.15") |
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
798 (make-obsolete 'dot-min 'point-min "before 19.15") |
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
799 (make-obsolete 'dot-marker 'point-marker "before 19.15") |
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
800 (make-obsolete 'buffer-flush-undo 'buffer-disable-undo "before 19.15") |
55884
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
parents:
55828
diff
changeset
|
801 (make-obsolete 'baud-rate "use the `baud-rate' variable instead." "before 19.15") |
46532
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
802 (make-obsolete 'compiled-function-p 'byte-code-function-p "before 19.15") |
6b003ac8d860
(dot, dot-max, dot-min, dot-marker, buffer-flush-undo, baud-rate,
Juanma Barranquero <lekktu@gmail.com>
parents:
46219
diff
changeset
|
803 (make-obsolete 'define-function 'defalias "20.1") |
55884
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
parents:
55828
diff
changeset
|
804 (make-obsolete 'focus-frame "it does nothing." "19.32") |
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
parents:
55828
diff
changeset
|
805 (make-obsolete 'unfocus-frame "it does nothing." "19.32") |
20605 | 806 |
42266
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
807 (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
|
808 "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
|
809 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
|
810 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
|
811 (dolist (el args) |
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
812 (insert (if (integerp el) (number-to-string el) el)))) |
46219
56b79cbf05d2
(insert-string): Update the obsolete info.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46148
diff
changeset
|
813 (make-obsolete 'insert-string 'insert "21.4") |
56b79cbf05d2
(insert-string): Update the obsolete info.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46148
diff
changeset
|
814 (defun makehash (&optional test) (make-hash-table :test (or test 'eql))) |
56b79cbf05d2
(insert-string): Update the obsolete info.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
46148
diff
changeset
|
815 (make-obsolete 'makehash 'make-hash-table "21.4") |
42266
75bbe9d566d9
(insert-string): Moved from mocklisp.c, reimplemented in Lisp. Obsoleted.
Pavel Janík <Pavel@Janik.cz>
parents:
42083
diff
changeset
|
816 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
817 ;; 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
|
818 (defun baud-rate () |
46052
4d27fe417297
(char-bytes): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents:
45978
diff
changeset
|
819 "Return the value of the `baud-rate' variable." |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
820 baud-rate) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
821 |
55884
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
parents:
55828
diff
changeset
|
822 (defalias 'focus-frame 'ignore "") |
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
parents:
55828
diff
changeset
|
823 (defalias 'unfocus-frame 'ignore "") |
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
824 |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
825 |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
826 ;;;; Obsolescence declarations for variables, and aliases. |
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
827 |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
828 (make-obsolete-variable 'directory-sep-char "do not use it." "21.1") |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
829 (make-obsolete-variable 'mode-line-inverse-video "use the appropriate faces instead." "21.1") |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
830 (make-obsolete-variable 'unread-command-char |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
831 "use `unread-command-events' instead. That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1." |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
832 "before 19.15") |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
833 (make-obsolete-variable 'executing-macro 'executing-kbd-macro "before 19.34") |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
834 (make-obsolete-variable 'post-command-idle-hook |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
835 "use timers instead, with `run-with-idle-timer'." "before 19.34") |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
836 (make-obsolete-variable 'post-command-idle-delay |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
837 "use timers instead, with `run-with-idle-timer'." "before 19.34") |
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
838 |
57778
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57689
diff
changeset
|
839 (defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions) |
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57689
diff
changeset
|
840 (make-obsolete-variable 'x-lost-selection-hooks 'x-lost-selection-functions "21.4") |
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57689
diff
changeset
|
841 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions) |
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57689
diff
changeset
|
842 (make-obsolete-variable 'x-sent-selection-hooks 'x-sent-selection-functions "21.4") |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
843 |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
844 (defvaralias 'messages-buffer-max-lines 'message-log-max) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
845 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
846 ;;;; 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
|
847 |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
848 (defalias 'string= 'string-equal) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
849 (defalias 'string< 'string-lessp) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
850 (defalias 'move-marker 'set-marker) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
851 (defalias 'rplaca 'setcar) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
852 (defalias 'rplacd 'setcdr) |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3411
diff
changeset
|
853 (defalias 'beep 'ding) ;preserve lingual purity |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
854 (defalias 'indent-to-column 'indent-to) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
855 (defalias 'backward-delete-char 'delete-backward-char) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
856 (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
|
857 (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
|
858 (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
|
859 (defalias 'store-match-data 'set-match-data) |
47078
6e9df2174ee2
(make-variable-frame-localizable): New alias for `make-variable-frame-local'.
Juanma Barranquero <lekktu@gmail.com>
parents:
47042
diff
changeset
|
860 (defalias 'make-variable-frame-localizable 'make-variable-frame-local) |
31563
96b9757bfd45
(add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents:
30515
diff
changeset
|
861 ;; These are the XEmacs names: |
25293
fd43e1a99384
(point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents:
25140
diff
changeset
|
862 (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
|
863 (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
|
864 |
87f63305319f
* subr.el (string-to-int): Make this an alias for
Jim Blandy <jimb@redhat.com>
parents:
1867
diff
changeset
|
865 ;;; 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
|
866 ;;; 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
|
867 (defalias 'string-to-int 'string-to-number) |
114 | 868 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
869 ;;;; Hook manipulation functions. |
388 | 870 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
871 (defun make-local-hook (hook) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
872 "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
|
873 The return value is HOOK. |
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
874 |
33707
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
875 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
|
876 if its LOCAL argument is non-nil. |
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
877 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
878 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
|
879 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
|
880 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
|
881 of the hook variable. |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
882 |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
883 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
|
884 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
|
885 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
|
886 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
|
887 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
|
888 one. |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
889 |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
890 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
|
891 buffer. |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
892 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
893 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
|
894 (if (local-variable-p hook) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
895 nil |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
896 (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
|
897 (make-local-variable hook) |
23786
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
898 (set hook (list t))) |
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
899 hook) |
46052
4d27fe417297
(char-bytes): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents:
45978
diff
changeset
|
900 (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
|
901 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
902 (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
|
903 "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
|
904 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
|
905 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
|
906 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
|
907 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
|
908 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
909 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
|
910 the hook's buffer-local value rather than its default value. |
43435 | 911 This makes the hook buffer-local if needed, and it makes t a member |
912 of the buffer-local value. That acts as a flag to run the hook | |
913 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
|
914 |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
915 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
|
916 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
|
917 function, it is changed to a list of functions." |
114 | 918 (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
|
919 (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
|
920 (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
|
921 (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
|
922 ;; 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
|
923 ;; and do what we used to do. |
52987
ac21698ba968
(add-hook): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
52896
diff
changeset
|
924 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook))) |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
925 (setq local t))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
926 (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
|
927 ;; 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
|
928 (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
|
929 (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
|
930 ;; 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
|
931 (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
|
932 (setq hook-value |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
933 (if append |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
934 (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
|
935 (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
|
936 ;; 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
|
937 (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
|
938 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
939 (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
|
940 "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
|
941 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
|
942 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
|
943 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
|
944 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
945 The optional third argument, LOCAL, if non-nil, says to modify |
52896
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
946 the hook's buffer-local value rather than its default value." |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
947 (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
|
948 (or (default-boundp hook) (set-default hook nil)) |
52896
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
949 ;; Do nothing if LOCAL is t but this hook has no local binding. |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
950 (unless (and local (not (local-variable-p hook))) |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
951 ;; 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
|
952 ;; and do what we used to do. |
52896
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
953 (when (and (local-variable-p hook) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
954 (not (and (consp (symbol-value hook)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
955 (memq t (symbol-value hook))))) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
956 (setq local t)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
957 (let ((hook-value (if local (symbol-value hook) (default-value hook)))) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
958 ;; Remove the function, for both the list and the non-list cases. |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
959 (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
960 (if (equal hook-value function) (setq hook-value nil)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
961 (setq hook-value (delete function (copy-sequence hook-value)))) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
962 ;; If the function is on the global hook, we need to shadow it locally |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
963 ;;(when (and local (member function (default-value hook)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
964 ;; (not (member (cons 'not function) hook-value))) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
965 ;; (push (cons 'not function) hook-value)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
966 ;; Set the actual variable |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
967 (if (not local) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
968 (set-default hook hook-value) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
969 (if (equal hook-value '(t)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
970 (kill-local-variable hook) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
971 (set hook hook-value)))))) |
9510
f03544494d1c
(add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9202
diff
changeset
|
972 |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
973 (defun add-to-list (list-var element &optional append) |
9535 | 974 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet. |
13812 | 975 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
|
976 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
|
977 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
|
978 ELEMENT is added at the end. |
24757
f4127409d184
(add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
24699
diff
changeset
|
979 |
43833 | 980 The return value is the new value of LIST-VAR. |
981 | |
9535 | 982 If you want to use `add-to-list' on a variable that is not defined |
983 until a certain package is loaded, you should put the call to `add-to-list' | |
984 into a hook function that will be run only after loading the package. | |
985 `eval-after-load' provides one way to do this. In some cases | |
986 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
|
987 (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
|
988 (symbol-value list-var) |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
989 (set list-var |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
990 (if append |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
991 (append (symbol-value list-var) (list element)) |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
992 (cons element (symbol-value list-var)))))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
993 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
994 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
995 ;;; Load history |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
996 |
47015
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
997 ;;; (defvar symbol-file-load-history-loaded nil |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
998 ;;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
999 ;;; That file records the part of `load-history' for preloaded files, |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1000 ;;; which is cleared out before dumping to make Emacs smaller.") |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1001 |
47015
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1002 ;;; (defun load-symbol-file-load-history () |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1003 ;;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done. |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1004 ;;; That file records the part of `load-history' for preloaded files, |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1005 ;;; which is cleared out before dumping to make Emacs smaller." |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1006 ;;; (unless symbol-file-load-history-loaded |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1007 ;;; (load (expand-file-name |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1008 ;;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1009 ;;; (if (eq system-type 'ms-dos) |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1010 ;;; "fns.el" |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1011 ;;; (format "fns-%s.el" emacs-version)) |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1012 ;;; exec-directory) |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1013 ;;; ;; The file name fns-%s.el already has a .el extension. |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1014 ;;; nil nil t) |
7faae7c35e07
(symbol-file-load-history-loaded)
Richard M. Stallman <rms@gnu.org>
parents:
46783
diff
changeset
|
1015 ;;; (setq symbol-file-load-history-loaded t))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1016 |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1017 (defun symbol-file (symbol &optional type) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1018 "Return the input source in which SYMBOL was defined. |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1019 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
|
1020 either an absolute file name, or a library name |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1021 \(with no directory name and no `.el' or `.elc' at the end). |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1022 It can also be nil, if the definition is not associated with any file. |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1023 |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1024 If TYPE is nil, then any kind of definition is acceptable. |
59161
0d5e992b6c18
Fix doc in previous change.
Richard M. Stallman <rms@gnu.org>
parents:
59124
diff
changeset
|
1025 If TYPE is `defun' or `defvar', that specifies function |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1026 definition only or variable definition only." |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1027 (if (and (or (null type) (eq type 'defun)) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1028 (symbolp symbol) (fboundp symbol) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1029 (eq 'autoload (car-safe (symbol-function symbol)))) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1030 (nth 1 (symbol-function symbol)) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1031 (let ((files load-history) |
48474
33dafec6a9de
(symbol-file): Remove unused variable `functions'.
John Paul Wallington <jpw@pobox.com>
parents:
48077
diff
changeset
|
1032 file) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1033 (while files |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1034 (if (if type |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1035 (if (eq type 'defvar) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1036 ;; Variables are present just as their names. |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1037 (member symbol (cdr (car files))) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1038 ;; Other types are represented as (TYPE . NAME). |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1039 (member (cons type symbol) (cdr (car files)))) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1040 ;; We accept all types, so look for variable def |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1041 ;; and then for any other kind. |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1042 (or (member symbol (cdr (car files))) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1043 (rassq symbol (cdr (car files))))) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1044 (setq file (car (car files)) files nil)) |
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1045 (setq files (cdr files))) |
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1046 file))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1047 |
114 | 1048 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1049 ;;;; 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
|
1050 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1051 (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
|
1052 "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
|
1053 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
|
1054 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
|
1055 It does nothing if FORM is already on the list for FILE. |
34750 | 1056 FILE must match exactly. Normally FILE is the name of a library, |
1057 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
|
1058 is normally called. |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
1059 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
|
1060 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
|
1061 (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
|
1062 ;; 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
|
1063 (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
|
1064 ;; 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
|
1065 (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
|
1066 (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
|
1067 ;; 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
|
1068 (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
|
1069 (featurep file) |
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
1070 ;; 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
|
1071 ;; Emacs for the case that FILE is one of them. |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1072 ;; (load-symbol-file-load-history) |
41140
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
1073 (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
|
1074 (eval form)))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1075 form) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1076 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1077 (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
|
1078 "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
|
1079 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
|
1080 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
|
1081 (eval-after-load file (read))) |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1082 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1083 ;;; make-network-process wrappers |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1084 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1085 (if (featurep 'make-network-process) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1086 (progn |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1087 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1088 (defun open-network-stream (name buffer host service) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1089 "Open a TCP connection for a service to a host. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1090 Returns a subprocess-object to represent the connection. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1091 Input and output work as for subprocesses; `delete-process' closes it. |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1092 |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1093 Args are NAME BUFFER HOST SERVICE. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1094 NAME is name for process. It is modified if necessary to make it unique. |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1095 BUFFER is the buffer (or buffer name) to associate with the process. |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1096 Process output goes at end of that buffer, unless you specify |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1097 an output stream or filter function to handle the output. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1098 BUFFER may be also nil, meaning that this process is not associated |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1099 with any buffer. |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1100 HOST is name of the host to connect to, or its IP address. |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1101 SERVICE is name of the service desired, or an integer specifying |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1102 a port number to connect to." |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1103 (make-network-process :name name :buffer buffer |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1104 :host host :service service)) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1105 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1106 (defun open-network-stream-nowait (name buffer host service &optional sentinel filter) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1107 "Initiate connection to a TCP connection for a service to a host. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1108 It returns nil if non-blocking connects are not supported; otherwise, |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1109 it returns a subprocess-object to represent the connection. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1110 |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1111 This function is similar to `open-network-stream', except that it |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1112 returns before the connection is established. When the connection |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1113 is completed, the sentinel function will be called with second arg |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1114 matching `open' (if successful) or `failed' (on error). |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1115 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1116 Args are NAME BUFFER HOST SERVICE SENTINEL FILTER. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1117 NAME, BUFFER, HOST, and SERVICE are as for `open-network-stream'. |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1118 Optional args SENTINEL and FILTER specify the sentinel and filter |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1119 functions to be used for this network stream." |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1120 (if (featurep 'make-network-process '(:nowait t)) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1121 (make-network-process :name name :buffer buffer :nowait t |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1122 :host host :service service |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1123 :filter filter :sentinel sentinel))) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1124 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1125 (defun open-network-stream-server (name buffer service &optional sentinel filter) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1126 "Create a network server process for a TCP service. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1127 It returns nil if server processes are not supported; otherwise, |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1128 it returns a subprocess-object to represent the server. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1129 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1130 When a client connects to the specified service, a new subprocess |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1131 is created to handle the new connection, and the sentinel function |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1132 is called for the new process. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1133 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1134 Args are NAME BUFFER SERVICE SENTINEL FILTER. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1135 NAME is name for the server process. Client processes are named by |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1136 appending the ip-address and port number of the client to NAME. |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1137 BUFFER is the buffer (or buffer name) to associate with the server |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1138 process. Client processes will not get a buffer if a process filter |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1139 is specified or BUFFER is nil; otherwise, a new buffer is created for |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1140 the client process. The name is similar to the process name. |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1141 Third arg SERVICE is name of the service desired, or an integer |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1142 specifying a port number to connect to. It may also be t to select |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1143 an unused port number for the server. |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1144 Optional args SENTINEL and FILTER specify the sentinel and filter |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1145 functions to be used for the client processes; the server process |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1146 does not use these function." |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1147 (if (featurep 'make-network-process '(:server t)) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1148 (make-network-process :name name :buffer buffer |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1149 :service service :server t :noquery t |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1150 :sentinel sentinel :filter filter))) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1151 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1152 )) ;; (featurep 'make-network-process) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1153 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1154 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1155 ;; compatibility |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1156 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1157 (make-obsolete 'process-kill-without-query |
55884
cd90d2110ad4
(process-kill-without-query): Remove spurious "\n" on obsolescence string.
Juanma Barranquero <lekktu@gmail.com>
parents:
55828
diff
changeset
|
1158 "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'." |
56738
749b147e12b9
(process-kill-without-query): Made obsolete in version 21.4, not 21.5.
John Paul Wallington <jpw@pobox.com>
parents:
56636
diff
changeset
|
1159 "21.4") |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1160 (defun process-kill-without-query (process &optional flag) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1161 "Say no query needed if PROCESS is running when Emacs is exited. |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1162 Optional second argument if non-nil says to require a query. |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1163 Value is t if a query was formerly required." |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1164 (let ((old (process-query-on-exit-flag process))) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1165 (set-process-query-on-exit-flag process nil) |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1166 old)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1167 |
49225
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1168 ;; process plist management |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1169 |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1170 (defun process-get (process propname) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1171 "Return the value of PROCESS' PROPNAME property. |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1172 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1173 (plist-get (process-plist process) propname)) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1174 |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1175 (defun process-put (process propname value) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1176 "Change PROCESS' PROPNAME property to VALUE. |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1177 It can be retrieved with `(process-get PROCESS PROPNAME)'." |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49492
diff
changeset
|
1178 (set-process-plist process |
49225
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1179 (plist-put (process-plist process) propname value))) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1180 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1181 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1182 ;;;; Input and display facilities. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1183 |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
1184 (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
|
1185 "*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
|
1186 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
|
1187 |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
1188 (custom-declare-variable-early |
47916 | 1189 'read-quoted-char-radix 8 |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
1190 "*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
|
1191 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
|
1192 :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
|
1193 :group 'editing-basics) |
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
1194 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1195 (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
|
1196 "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
|
1197 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
|
1198 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
|
1199 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
|
1200 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
|
1201 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
|
1202 |
21008
7111f9cf9392
(read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
20939
diff
changeset
|
1203 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
|
1204 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
|
1205 for numeric input." |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1206 (let ((message-log-max nil) done (first t) (code 0) char translated) |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1207 (while (not done) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1208 (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
|
1209 ;; 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
|
1210 (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
|
1211 (help-form |
f75e47f673f4
(read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents:
12016
diff
changeset
|
1212 "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
|
1213 or the octal character code. |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
1214 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
|
1215 any other non-digit terminates the character code and is then used as input.")) |
47747
399628a16c0a
(read-key-auxiliary-map, read-key): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47690
diff
changeset
|
1216 (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
|
1217 (if inhibit-quit (setq quit-flag nil))) |
47747
399628a16c0a
(read-key-auxiliary-map, read-key): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47690
diff
changeset
|
1218 ;; Translate TAB key into control-I ASCII character, and so on. |
399628a16c0a
(read-key-auxiliary-map, read-key): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47690
diff
changeset
|
1219 ;; Note: `read-char' does it using the `ascii-character' property. |
399628a16c0a
(read-key-auxiliary-map, read-key): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47690
diff
changeset
|
1220 ;; We could try and use read-key-sequence instead, but then C-q ESC |
399628a16c0a
(read-key-auxiliary-map, read-key): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47690
diff
changeset
|
1221 ;; or C-q C-x might not return immediately since ESC or C-x might be |
399628a16c0a
(read-key-auxiliary-map, read-key): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47690
diff
changeset
|
1222 ;; bound to some prefix in function-key-map or key-translation-map. |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1223 (setq translated char) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1224 (let ((translation (lookup-key function-key-map (vector char)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1225 (if (arrayp translation) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1226 (setq translated (aref translation 0)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1227 (cond ((null translated)) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1228 ((not (integerp translated)) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1229 (setq unread-command-events (list char) |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
1230 done t)) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1231 ((/= (logand translated ?\M-\^@) 0) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
1232 ;; Turn a meta-character into a character with the 0200 bit set. |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1233 (setq code (logior (logand translated (lognot ?\M-\^@)) 128) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
1234 done t)) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1235 ((and (<= ?0 translated) (< translated (+ ?0 (min 10 read-quoted-char-radix)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1236 (setq code (+ (* code read-quoted-char-radix) (- translated ?0))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1237 (and prompt (setq prompt (message "%s %c" prompt translated)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1238 ((and (<= ?a (downcase translated)) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1239 (< (downcase translated) (+ ?a -10 (min 36 read-quoted-char-radix)))) |
19002
f21881dcd27b
(read-quoted-char): Consistently downcase letter "digits".
Richard M. Stallman <rms@gnu.org>
parents:
18948
diff
changeset
|
1240 (setq code (+ (* code read-quoted-char-radix) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1241 (+ 10 (- (downcase translated) ?a)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1242 (and prompt (setq prompt (message "%s %c" prompt translated)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1243 ((and (not first) (eq translated ?\C-m)) |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1244 (setq done t)) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1245 ((not first) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1246 (setq unread-command-events (list char) |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1247 done t)) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1248 (t (setq code translated |
18821
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1249 done t))) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1250 (setq first nil)) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
1251 code)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1252 |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1253 (defun read-passwd (prompt &optional confirm default) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1254 "Read a password, prompting with PROMPT, and return it. |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1255 If optional CONFIRM is non-nil, read the password twice to make sure. |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1256 Optional DEFAULT is a default password to use instead of empty input. |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1257 |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1258 This function echoes `.' for each character that the user types. |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1259 The user ends with RET, LFD, or ESC. DEL or C-h rubs out. C-u kills line. |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1260 C-g quits; if `inhibit-quit' was non-nil around this function, |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1261 then it returns nil if the user types C-g. |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1262 |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1263 Once the caller uses the password, it can erase the password |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1264 by doing (clear-string STRING)." |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1265 (with-local-quit |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1266 (if confirm |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1267 (let (success) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1268 (while (not success) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1269 (let ((first (read-passwd prompt nil default)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1270 (second (read-passwd "Confirm password: " nil default))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1271 (if (equal first second) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1272 (progn |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1273 (and (arrayp second) (clear-string second)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1274 (setq success first)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1275 (and (arrayp first) (clear-string first)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1276 (and (arrayp second) (clear-string second)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1277 (message "Password not repeated accurately; please start over") |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1278 (sit-for 1)))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1279 success) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1280 (let ((pass nil) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1281 (c 0) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1282 (echo-keystrokes 0) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1283 (cursor-in-echo-area t)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1284 (while (progn (message "%s%s" |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1285 prompt |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1286 (make-string (length pass) ?.)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1287 (setq c (read-char-exclusive nil t)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1288 (and (/= c ?\r) (/= c ?\n) (/= c ?\e))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1289 (clear-this-command-keys) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1290 (if (= c ?\C-u) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1291 (progn |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1292 (and (arrayp pass) (clear-string pass)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1293 (setq pass "")) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1294 (if (and (/= c ?\b) (/= c ?\177)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1295 (let* ((new-char (char-to-string c)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1296 (new-pass (concat pass new-char))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1297 (and (arrayp pass) (clear-string pass)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1298 (clear-string new-char) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1299 (setq c ?\0) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1300 (setq pass new-pass)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1301 (if (> (length pass) 0) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1302 (let ((new-pass (substring pass 0 -1))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1303 (and (arrayp pass) (clear-string pass)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1304 (setq pass new-pass)))))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1305 (message nil) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1306 (or pass default ""))))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1307 |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1308 ;; This should be used by `call-interactively' for `n' specs. |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1309 (defun read-number (prompt &optional default) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1310 (let ((n nil)) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1311 (when default |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1312 (setq prompt |
55891
3c32f5d8430f
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
Miles Bader <miles@gnu.org>
parents:
55884
diff
changeset
|
1313 (if (string-match "\\(\\):[ \t]*\\'" prompt) |
3c32f5d8430f
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
Miles Bader <miles@gnu.org>
parents:
55884
diff
changeset
|
1314 (replace-match (format " (default %s)" default) t t prompt 1) |
3c32f5d8430f
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
Miles Bader <miles@gnu.org>
parents:
55884
diff
changeset
|
1315 (replace-regexp-in-string "[ \t]*\\'" |
3c32f5d8430f
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-363
Miles Bader <miles@gnu.org>
parents:
55884
diff
changeset
|
1316 (format " (default %s) " default) |
55976
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
parents:
55891
diff
changeset
|
1317 prompt t t)))) |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1318 (while |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1319 (progn |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1320 (let ((str (read-from-minibuffer prompt nil nil nil nil |
55008
f5cafaedbab0
(read-number): Check whether `default' is nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54887
diff
changeset
|
1321 (and default |
f5cafaedbab0
(read-number): Check whether `default' is nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54887
diff
changeset
|
1322 (number-to-string default))))) |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1323 (setq n (cond |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1324 ((zerop (length str)) default) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1325 ((stringp str) (read str))))) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1326 (unless (numberp n) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1327 (message "Please enter a number.") |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1328 (sit-for 1) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1329 t))) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1330 n)) |
20472
79ea90039b23
(read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20410
diff
changeset
|
1331 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1332 ;;; Atomic change groups. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1333 |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1334 (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
|
1335 "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
|
1336 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
|
1337 all of its changes to the current buffer are undone. |
46783
a4e9eb2530cb
(atomic-change-group): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
46537
diff
changeset
|
1338 This works regardless of whether undo is enabled in the buffer. |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1339 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1340 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
|
1341 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
|
1342 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
|
1343 (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
|
1344 (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
|
1345 `(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
|
1346 (,success nil)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1347 (unwind-protect |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1348 (progn |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1349 ;; 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
|
1350 ;; 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
|
1351 ;; 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
|
1352 (activate-change-group ,handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1353 ,@body |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1354 (setq ,success t)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1355 ;; 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
|
1356 ;; 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
|
1357 (if ,success |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1358 (accept-change-group ,handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1359 (cancel-change-group ,handle)))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1360 |
51068
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
1361 (defun prepare-change-group (&optional buffer) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1362 "Return a handle for the current buffer's state, for a change group. |
51068
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
1363 If you specify BUFFER, make a handle for BUFFER's state instead. |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1364 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1365 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
|
1366 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
|
1367 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1368 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
|
1369 `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
|
1370 `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
|
1371 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
|
1372 `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
|
1373 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
|
1374 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
|
1375 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
|
1376 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
|
1377 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1378 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
|
1379 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
|
1380 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
|
1381 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1382 (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
|
1383 (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
|
1384 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1385 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
|
1386 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
|
1387 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
|
1388 |
51068
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
1389 (if buffer |
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
1390 (list (cons buffer (with-current-buffer buffer buffer-undo-list))) |
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
1391 (list (cons (current-buffer) buffer-undo-list)))) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1392 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1393 (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
|
1394 "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
|
1395 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1396 (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
|
1397 (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
|
1398 (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
|
1399 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1400 (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
|
1401 "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
|
1402 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
|
1403 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1404 (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
|
1405 (if (eq elt t) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1406 (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
|
1407 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1408 (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
|
1409 "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
|
1410 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
|
1411 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1412 (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
|
1413 (setq elt (cdr elt)) |
47916 | 1414 (let ((old-car |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1415 (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
|
1416 (old-cdr |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1417 (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
|
1418 ;; 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
|
1419 (when (consp elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1420 (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
|
1421 (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
|
1422 ;; 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
|
1423 (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
|
1424 (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
|
1425 ;; Undo it all. |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1426 (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
|
1427 ;; 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
|
1428 (when (consp elt) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1429 (setcar elt old-car) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1430 (setcdr elt old-cdr)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
1431 ;; 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
|
1432 (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
|
1433 |
44285
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
1434 ;; For compatibility. |
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
1435 (defalias 'redraw-modeline 'force-mode-line-update) |
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
1436 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1437 (defun force-mode-line-update (&optional all) |
52858
b4112065d679
(force-mode-line-update): Fix docstring.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
1438 "Force redisplay of the current buffer's mode line and header line. |
b4112065d679
(force-mode-line-update): Fix docstring.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
1439 With optional non-nil ALL, force redisplay of all mode lines and |
b4112065d679
(force-mode-line-update): Fix docstring.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
1440 header lines. This function also forces recomputation of the |
b4112065d679
(force-mode-line-update): Fix docstring.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
1441 menu bar menus and the frame title." |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1442 (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
|
1443 (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
|
1444 |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1445 (defun momentary-string-display (string pos &optional exit-char message) |
114 | 1446 "Momentarily display STRING in the buffer at POS. |
55187
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1447 Display remains until next event is input. |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1448 Optional third arg EXIT-CHAR can be a character, event or event |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1449 description list. EXIT-CHAR defaults to SPC. If the input is |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1450 EXIT-CHAR it is swallowed; otherwise it is then available as |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1451 input (as a command if nothing else). |
114 | 1452 Display MESSAGE (optional fourth arg) in the echo area. |
1453 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." | |
1454 (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
|
1455 (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
|
1456 ;; 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
|
1457 (buffer-undo-list t) |
114 | 1458 (modified (buffer-modified-p)) |
1459 (name buffer-file-name) | |
1460 insert-end) | |
1461 (unwind-protect | |
1462 (progn | |
1463 (save-excursion | |
1464 (goto-char pos) | |
1465 ;; defeat file locking... don't try this at home, kids! | |
1466 (setq buffer-file-name nil) | |
1467 (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
|
1468 (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
|
1469 ;; 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
|
1470 (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
|
1471 (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
|
1472 ;; 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
|
1473 ;; 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
|
1474 (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
|
1475 (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
|
1476 (progn |
5474175de175
(momentary-string-display): Scroll to keep the string on the screen.
Richard M. Stallman <rms@gnu.org>
parents:
4518
diff
changeset
|
1477 (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
|
1478 (recenter 0)))) |
114 | 1479 (message (or message "Type %s to continue editing.") |
1480 (single-key-description exit-char)) | |
55187
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1481 (let (char) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1482 (if (integerp exit-char) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1483 (condition-case nil |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1484 (progn |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1485 (setq char (read-char)) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1486 (or (eq char exit-char) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1487 (setq unread-command-events (list char)))) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1488 (error |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1489 ;; `exit-char' is a character, hence it differs |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1490 ;; from char, which is an event. |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1491 (setq unread-command-events (list char)))) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1492 ;; `exit-char' can be an event, or an event description |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1493 ;; list. |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1494 (setq char (read-event)) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1495 (or (eq char exit-char) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1496 (eq char (event-convert-list exit-char)) |
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
1497 (setq unread-command-events (list char)))))) |
114 | 1498 (if insert-end |
1499 (save-excursion | |
1500 (delete-region pos insert-end))) | |
1501 (setq buffer-file-name name) | |
1502 (set-buffer-modified-p modified)))) | |
1503 | |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1504 |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1505 ;;;; Overlay operations |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1506 |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1507 (defun copy-overlay (o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1508 "Return a copy of overlay O." |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1509 (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
|
1510 ;; 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
|
1511 ;; insertion-type of the two markers. |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1512 (overlay-buffer o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1513 (props (overlay-properties o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1514 (while props |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1515 (overlay-put o1 (pop props) (pop props))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1516 o1)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1517 |
55202
4c64ee838f41
* subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents:
55187
diff
changeset
|
1518 (defun remove-overlays (&optional beg end name val) |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1519 "Clear BEG and END of overlays whose property NAME has value VAL. |
55477
e191e6d1554e
(remove-overlays, read-passwd): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55406
diff
changeset
|
1520 Overlays might be moved and/or split. |
e191e6d1554e
(remove-overlays, read-passwd): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55406
diff
changeset
|
1521 BEG and END default respectively to the beginning and end of buffer." |
55202
4c64ee838f41
* subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents:
55187
diff
changeset
|
1522 (unless beg (setq beg (point-min))) |
4c64ee838f41
* subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents:
55187
diff
changeset
|
1523 (unless end (setq end (point-max))) |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1524 (if (< end beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1525 (setq beg (prog1 end (setq end beg)))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1526 (save-excursion |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1527 (dolist (o (overlays-in beg end)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1528 (when (eq (overlay-get o name) val) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1529 ;; Either push this overlay outside beg...end |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1530 ;; or split it to exclude beg...end |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1531 ;; 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
|
1532 (if (< (overlay-start o) beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1533 (if (> (overlay-end o) end) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1534 (progn |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1535 (move-overlay (copy-overlay o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1536 (overlay-start o) beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1537 (move-overlay o end (overlay-end o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1538 (move-overlay o (overlay-start o) beg)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1539 (if (> (overlay-end o) end) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1540 (move-overlay o end (overlay-end o)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
1541 (delete-overlay o))))))) |
42917
ec2db12c7670
(copy-without-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
42266
diff
changeset
|
1542 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1543 ;;;; Miscellanea. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1544 |
10254
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1545 ;; A number of major modes set this locally. |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1546 ;; 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
|
1547 (defvar font-lock-defaults nil) |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1548 |
20846
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1549 (defvar suspend-hook nil |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1550 "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
|
1551 |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1552 (defvar suspend-resume-hook nil |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
1553 "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
|
1554 |
42083
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1555 (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
|
1556 "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
|
1557 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
|
1558 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
|
1559 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
|
1560 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
|
1561 |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1562 (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
|
1563 "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
|
1564 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
|
1565 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
|
1566 mode.") |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
1567 |
10254
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1568 ;; Avoid compiler warnings about this variable, |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1569 ;; 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
|
1570 (defvar buffer-file-type nil |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
1571 "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
|
1572 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
|
1573 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
|
1574 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
|
1575 |
14515
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1576 ;; 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
|
1577 (defun get-buffer-window-list (buffer &optional minibuf frame) |
56398
92855ff2cb86
(get-buffer-window-list): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
55976
diff
changeset
|
1578 "Return list of all windows displaying BUFFER, or nil if none. |
92855ff2cb86
(get-buffer-window-list): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
55976
diff
changeset
|
1579 BUFFER can be a buffer or a buffer name. |
14707
ddcae263bb18
Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents:
14517
diff
changeset
|
1580 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
|
1581 (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
|
1582 (walk-windows (function (lambda (window) |
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1583 (if (eq (window-buffer window) buffer) |
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1584 (setq windows (cons window windows))))) |
14707
ddcae263bb18
Make get-buffer-window-list take MINIBUF arg.
Simon Marshall <simon@gnu.org>
parents:
14517
diff
changeset
|
1585 minibuf frame) |
14515
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1586 windows)) |
b35134a0e47a
Added get-buffer-window-list.
Simon Marshall <simon@gnu.org>
parents:
14343
diff
changeset
|
1587 |
8211
08fb5e917205
(ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents:
7693
diff
changeset
|
1588 (defun ignore (&rest ignore) |
08fb5e917205
(ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents:
7693
diff
changeset
|
1589 "Do nothing and return nil. |
08fb5e917205
(ignore): Put doc string in right place.
Richard M. Stallman <rms@gnu.org>
parents:
7693
diff
changeset
|
1590 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
|
1591 (interactive) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1592 nil) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1593 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1594 (defun error (&rest args) |
13936 | 1595 "Signal an error, making error message by passing all args to `format'. |
1596 In Emacs, the convention is that error messages start with a capital | |
1597 letter but *do not* end with a period. Please follow this convention | |
1598 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
|
1599 (while t |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1600 (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
|
1601 |
5912
909b94d547c4
(user-original-login-name): Reduce to a defalias, since it's redundant with
Karl Heuer <kwzh@gnu.org>
parents:
5844
diff
changeset
|
1602 (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
|
1603 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1604 (defvar yank-excluded-properties) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1605 |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1606 (defun remove-yank-excluded-properties (start end) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1607 "Remove `yank-excluded-properties' between START and END positions. |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1608 Replaces `category' properties with their defined properties." |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1609 (let ((inhibit-read-only t)) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1610 ;; Replace any `category' property with the properties it stands for. |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1611 (unless (memq yank-excluded-properties '(t nil)) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1612 (save-excursion |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1613 (goto-char start) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1614 (while (< (point) end) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1615 (let ((cat (get-text-property (point) 'category)) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1616 run-end) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1617 (setq run-end |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1618 (next-single-property-change (point) 'category nil end)) |
47675
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1619 (when cat |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1620 (let (run-end2 original) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1621 (remove-list-of-text-properties (point) run-end '(category)) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1622 (while (< (point) run-end) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1623 (setq run-end2 (next-property-change (point) nil run-end)) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1624 (setq original (text-properties-at (point))) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1625 (set-text-properties (point) run-end2 (symbol-plist cat)) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1626 (add-text-properties (point) run-end2 original) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1627 (goto-char run-end2)))) |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1628 (goto-char run-end))))) |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1629 (if (eq yank-excluded-properties t) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1630 (set-text-properties start end nil) |
47675
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
1631 (remove-list-of-text-properties start end yank-excluded-properties)))) |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1632 |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1633 (defvar yank-undo-function) |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1634 |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1635 (defun insert-for-yank (string) |
53368
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1636 "Calls `insert-for-yank-1' repetitively for each `yank-handler' segment. |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1637 |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1638 See `insert-for-yank-1' for more details." |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1639 (let (to) |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1640 (while (setq to (next-single-property-change 0 'yank-handler string)) |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1641 (insert-for-yank-1 (substring string 0 to)) |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1642 (setq string (substring string to)))) |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1643 (insert-for-yank-1 string)) |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1644 |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1645 (defun insert-for-yank-1 (string) |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1646 "Insert STRING at point, stripping some text properties. |
53368
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
1647 |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1648 Strip text properties from the inserted text according to |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1649 `yank-excluded-properties'. Otherwise just like (insert STRING). |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1650 |
49363 | 1651 If STRING has a non-nil `yank-handler' property on the first character, |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1652 the normal insert behaviour is modified in various ways. The value of |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1653 the yank-handler property must be a list with one to five elements |
49492
a144c40bb984
(insert-for-yank): Remove COMMAND element from yank handler.
Kim F. Storm <storm@cua.dk>
parents:
49363
diff
changeset
|
1654 with the following format: (FUNCTION PARAM NOEXCLUDE UNDO). |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1655 When FUNCTION is present and non-nil, it is called instead of `insert' |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1656 to insert the string. FUNCTION takes one argument--the object to insert. |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1657 If PARAM is present and non-nil, it replaces STRING as the object |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1658 passed to FUNCTION (or `insert'); for example, if FUNCTION is |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1659 `yank-rectangle', PARAM may be a list of strings to insert as a |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1660 rectangle. |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1661 If NOEXCLUDE is present and non-nil, the normal removal of the |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1662 yank-excluded-properties is not performed; instead FUNCTION is |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1663 responsible for removing those properties. This may be necessary |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1664 if FUNCTION adjusts point before or after inserting the object. |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1665 If UNDO is present and non-nil, it is a function that will be called |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1666 by `yank-pop' to undo the insertion of the current object. It is |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49492
diff
changeset
|
1667 called with two arguments, the start and end of the current region. |
49492
a144c40bb984
(insert-for-yank): Remove COMMAND element from yank handler.
Kim F. Storm <storm@cua.dk>
parents:
49363
diff
changeset
|
1668 FUNCTION may set `yank-undo-function' to override the UNDO value." |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1669 (let* ((handler (and (stringp string) |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1670 (get-text-property 0 'yank-handler string))) |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1671 (param (or (nth 1 handler) string)) |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1672 (opoint (point))) |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1673 (setq yank-undo-function t) |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1674 (if (nth 0 handler) ;; FUNCTION |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1675 (funcall (car handler) param) |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1676 (insert param)) |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1677 (unless (nth 2 handler) ;; NOEXCLUDE |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
1678 (remove-yank-excluded-properties opoint (point))) |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1679 (if (eq yank-undo-function t) ;; not set by FUNCTION |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1680 (setq yank-undo-function (nth 3 handler))) ;; UNDO |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1681 (if (nth 4 handler) ;; COMMAND |
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
1682 (setq this-command (nth 4 handler))))) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49492
diff
changeset
|
1683 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1684 (defun insert-buffer-substring-no-properties (buffer &optional start end) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1685 "Insert before point a substring of BUFFER, without text properties. |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1686 BUFFER may be a buffer or a buffer name. |
55976
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
parents:
55891
diff
changeset
|
1687 Arguments START and END are character positions specifying the substring. |
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
parents:
55891
diff
changeset
|
1688 They default to the values of (point-min) and (point-max) in BUFFER." |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1689 (let ((opoint (point))) |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1690 (insert-buffer-substring buffer start end) |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1691 (let ((inhibit-read-only t)) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1692 (set-text-properties opoint (point) nil)))) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1693 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1694 (defun insert-buffer-substring-as-yank (buffer &optional start end) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1695 "Insert before point a part of BUFFER, stripping some text properties. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1696 BUFFER may be a buffer or a buffer name. |
55976
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
parents:
55891
diff
changeset
|
1697 Arguments START and END are character positions specifying the substring. |
bb7bcfc53d76
(insert-buffer-substring-no-properties, insert-buffer-substring-as-yank):
Juanma Barranquero <lekktu@gmail.com>
parents:
55891
diff
changeset
|
1698 They default to the values of (point-min) and (point-max) in BUFFER. |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1699 Strip text properties from the inserted text according to |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1700 `yank-excluded-properties'." |
52379 | 1701 ;; Since the buffer text should not normally have yank-handler properties, |
1702 ;; there is no need to handle them here. | |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1703 (let ((opoint (point))) |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
1704 (insert-buffer-substring buffer start end) |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
1705 (remove-yank-excluded-properties opoint (point)))) |
44723
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
1706 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1707 |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1708 ;; Synchronous shell commands. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
1709 |
114 | 1710 (defun start-process-shell-command (name buffer &rest args) |
1711 "Start a program in a subprocess. Return the process object for it. | |
1712 NAME is name for process. It is modified if necessary to make it unique. | |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1713 BUFFER is the buffer (or buffer name) to associate with the process. |
114 | 1714 Process output goes at end of that buffer, unless you specify |
1715 an output stream or filter function to handle the output. | |
1716 BUFFER may be also nil, meaning that this process is not associated | |
1717 with any buffer | |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1718 COMMAND is the name of a shell command. |
114 | 1719 Remaining arguments are the arguments for the command. |
55502
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1720 Wildcards and redirection are handled as usual in the shell. |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1721 |
75efe89a09b7
(start-process-shell-command): Fix docstring. Put usage info in a format usable
Juanma Barranquero <lekktu@gmail.com>
parents:
55477
diff
changeset
|
1722 \(fn NAME BUFFER COMMAND &rest COMMAND-ARGS)" |
9822
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1723 (cond |
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1724 ((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
|
1725 (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
|
1726 ;; 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
|
1727 ;; 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
|
1728 (t |
248462096d25
(start-process-shell-command): Don't use exec on windows-nt.
Karl Heuer <kwzh@gnu.org>
parents:
9535
diff
changeset
|
1729 (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
|
1730 (mapconcat 'identity args " "))))) |
39598
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1731 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1732 (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
|
1733 &rest args) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1734 "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
|
1735 The remaining arguments are optional. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1736 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
|
1737 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
|
1738 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
|
1739 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
|
1740 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
|
1741 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
|
1742 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
|
1743 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
|
1744 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1745 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
|
1746 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
|
1747 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
|
1748 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1749 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
|
1750 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
|
1751 status or a signal description string. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1752 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
|
1753 (cond |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1754 ((eq system-type 'vax-vms) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1755 (apply 'call-process command infile buffer display args)) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1756 ;; 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
|
1757 ;; but that failed to handle (...) and semicolon, etc. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1758 (t |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1759 (call-process shell-file-name |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1760 infile buffer display |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1761 shell-command-switch |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
1762 (mapconcat 'identity (cons command args) " "))))) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
1763 |
16277
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
1764 (defmacro with-current-buffer (buffer &rest body) |
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
1765 "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
|
1766 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
|
1767 See also `with-temp-buffer'." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1768 (declare (indent 1) (debug t)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1769 `(save-current-buffer |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1770 (set-buffer ,buffer) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1771 ,@body)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1772 |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1773 (defmacro with-selected-window (window &rest body) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1774 "Execute the forms in BODY with WINDOW as the selected window. |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1775 The value returned is the value of the last form in BODY. |
51980
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
1776 This does not alter the buffer list ordering. |
56402
78189fca7611
(with-selected-window): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56398
diff
changeset
|
1777 This function saves and restores the selected window, as well as |
78189fca7611
(with-selected-window): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56398
diff
changeset
|
1778 the selected window in each frame. If the previously selected |
78189fca7611
(with-selected-window): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56398
diff
changeset
|
1779 window of some frame is no longer live at the end of BODY, that |
78189fca7611
(with-selected-window): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56398
diff
changeset
|
1780 frame's selected window is left alone. If the selected window is |
78189fca7611
(with-selected-window): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56398
diff
changeset
|
1781 no longer live, then whatever window is selected at the end of |
78189fca7611
(with-selected-window): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56398
diff
changeset
|
1782 BODY remains selected. |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1783 See also `with-temp-buffer'." |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1784 (declare (indent 1) (debug t)) |
55828
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1785 ;; Most of this code is a copy of save-selected-window. |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1786 `(let ((save-selected-window-window (selected-window)) |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1787 ;; It is necessary to save all of these, because calling |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1788 ;; select-window changes frame-selected-window for whatever |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1789 ;; frame that window is in. |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1790 (save-selected-window-alist |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1791 (mapcar (lambda (frame) (list frame (frame-selected-window frame))) |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1792 (frame-list)))) |
51980
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
1793 (unwind-protect |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
1794 (progn (select-window ,window 'norecord) |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
1795 ,@body) |
55828
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1796 (dolist (elt save-selected-window-alist) |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1797 (and (frame-live-p (car elt)) |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1798 (window-live-p (cadr elt)) |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
1799 (set-frame-selected-window (car elt) (cadr elt)))) |
51980
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
1800 (if (window-live-p save-selected-window-window) |
51983
9e88997e86c3
(with-selected-window): Add closing paren.
John Paul Wallington <jpw@pobox.com>
parents:
51980
diff
changeset
|
1801 (select-window save-selected-window-window 'norecord))))) |
16277
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
1802 |
23736 | 1803 (defmacro with-temp-file (file &rest body) |
1804 "Create a new buffer, evaluate BODY there, and write the buffer to FILE. | |
1805 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
|
1806 See also `with-temp-buffer'." |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
1807 (declare (debug t)) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
1808 (let ((temp-file (make-symbol "temp-file")) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1809 (temp-buffer (make-symbol "temp-buffer"))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1810 `(let ((,temp-file ,file) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1811 (,temp-buffer |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1812 (get-buffer-create (generate-new-buffer-name " *temp file*")))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1813 (unwind-protect |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1814 (prog1 |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1815 (with-current-buffer ,temp-buffer |
23736 | 1816 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1817 (with-current-buffer ,temp-buffer |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1818 (widen) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1819 (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
|
1820 (and (buffer-name ,temp-buffer) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1821 (kill-buffer ,temp-buffer)))))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1822 |
23736 | 1823 (defmacro with-temp-message (message &rest body) |
24011 | 1824 "Display MESSAGE temporarily if non-nil while BODY is evaluated. |
23736 | 1825 The original message is restored to the echo area after BODY has finished. |
1826 The value returned is the value of the last form in BODY. | |
24011 | 1827 MESSAGE is written to the message log buffer if `message-log-max' is non-nil. |
1828 If MESSAGE is nil, the echo area and message log buffer are unchanged. | |
1829 Use a MESSAGE of \"\" to temporarily clear the echo area." | |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
1830 (declare (debug t)) |
24000
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1831 (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
|
1832 (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
|
1833 `(let ((,temp-message ,message) |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1834 (,current-message)) |
23736 | 1835 (unwind-protect |
1836 (progn | |
24000
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1837 (when ,temp-message |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
1838 (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
|
1839 (message "%s" ,temp-message)) |
23736 | 1840 ,@body) |
42076
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1841 (and ,temp-message |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1842 (if ,current-message |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1843 (message "%s" ,current-message) |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
1844 (message nil))))))) |
23736 | 1845 |
1846 (defmacro with-temp-buffer (&rest body) | |
1847 "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
|
1848 See also `with-temp-file' and `with-output-to-string'." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1849 (declare (indent 0) (debug t)) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1850 (let ((temp-buffer (make-symbol "temp-buffer"))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
1851 `(let ((,temp-buffer (generate-new-buffer " *temp*"))) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1852 (unwind-protect |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1853 (with-current-buffer ,temp-buffer |
23736 | 1854 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1855 (and (buffer-name ,temp-buffer) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1856 (kill-buffer ,temp-buffer)))))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1857 |
16311
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1858 (defmacro with-output-to-string (&rest body) |
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1859 "Execute BODY, return the text it sent to `standard-output', as a string." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1860 (declare (indent 0) (debug t)) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1861 `(let ((standard-output |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1862 (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
|
1863 (let ((standard-output standard-output)) |
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
1864 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1865 (with-current-buffer standard-output |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1866 (prog1 |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1867 (buffer-string) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
1868 (kill-buffer nil))))) |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1869 |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1870 (defmacro with-local-quit (&rest body) |
56565
1bef61b14e78
(with-local-quit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
56537
diff
changeset
|
1871 "Execute BODY, allowing quits to terminate BODY but not escape further. |
57547
5d572f497d32
(with-local-quit): Return nil if there's a quit.
Richard M. Stallman <rms@gnu.org>
parents:
57523
diff
changeset
|
1872 When a quit terminates BODY, `with-local-quit' returns nil but |
5d572f497d32
(with-local-quit): Return nil if there's a quit.
Richard M. Stallman <rms@gnu.org>
parents:
57523
diff
changeset
|
1873 requests another quit. That quit will be processed, the next time quitting |
5d572f497d32
(with-local-quit): Return nil if there's a quit.
Richard M. Stallman <rms@gnu.org>
parents:
57523
diff
changeset
|
1874 is allowed once again." |
48475
4bdcb09d9f25
(symbol-file): Accept a non-atomic `function' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48474
diff
changeset
|
1875 (declare (debug t) (indent 0)) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1876 `(condition-case nil |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1877 (let ((inhibit-quit nil)) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1878 ,@body) |
57547
5d572f497d32
(with-local-quit): Return nil if there's a quit.
Richard M. Stallman <rms@gnu.org>
parents:
57523
diff
changeset
|
1879 (quit (setq quit-flag t) nil))) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
1880 |
58934
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1881 (defmacro while-no-input (&rest body) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1882 "Execute BODY only as long as there's no pending input. |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1883 If input arrives, that ends the execution of BODY, |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1884 and `while-no-input' returns nil. If BODY finishes, |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1885 `while-no-input' returns whatever value BODY produced." |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1886 (declare (debug t) (indent 0)) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1887 (let ((catch-sym (make-symbol "input"))) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1888 `(with-local-quit |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1889 (catch ',catch-sym |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1890 (let ((throw-on-input ',catch-sym)) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1891 (when (sit-for 0 0 t) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1892 ,@body)))))) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
1893 |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1894 (defmacro combine-after-change-calls (&rest body) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1895 "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
|
1896 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
|
1897 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
|
1898 when BODY is finished. |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
1899 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
|
1900 |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1901 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
|
1902 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
|
1903 |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1904 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
|
1905 in BODY." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
1906 (declare (indent 0) (debug t)) |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1907 `(unwind-protect |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1908 (let ((combine-after-change-calls t)) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1909 . ,body) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1910 (combine-after-change-execute))) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
1911 |
28234
763c6639628b
(combine-run-hooks): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28148
diff
changeset
|
1912 |
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
|
1913 (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
|
1914 "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
|
1915 (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
|
1916 "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
|
1917 (make-variable-buffer-local 'delayed-mode-hooks) |
53412
a2bba9e88b95
(assoc-ignore-case, assoc-ignore-representation):
Richard M. Stallman <rms@gnu.org>
parents:
53368
diff
changeset
|
1918 (put 'delay-mode-hooks 'permanent-local t) |
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
|
1919 |
57145
26c822f42ae4
(after-change-major-mode-hook): New variable.
Luc Teirlinck <teirllm@auburn.edu>
parents:
57006
diff
changeset
|
1920 (defvar after-change-major-mode-hook nil |
57186
a76a93daaed3
(after-change-major-mode-hook): Further doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
57184
diff
changeset
|
1921 "Normal hook run at the very end of major mode functions.") |
57145
26c822f42ae4
(after-change-major-mode-hook): New variable.
Luc Teirlinck <teirllm@auburn.edu>
parents:
57006
diff
changeset
|
1922 |
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
|
1923 (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
|
1924 "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
|
1925 Execution is delayed if `delay-mode-hooks' is non-nil. |
57176
2da0a6d97b14
(run-mode-hooks): Run `after-change-major-mode-hook' after the
Luc Teirlinck <teirllm@auburn.edu>
parents:
57151
diff
changeset
|
1926 If `delay-mode-hooks' is nil, run `after-change-major-mode-hook' |
2da0a6d97b14
(run-mode-hooks): Run `after-change-major-mode-hook' after the
Luc Teirlinck <teirllm@auburn.edu>
parents:
57151
diff
changeset
|
1927 after running the mode hooks. |
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
|
1928 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
|
1929 (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
|
1930 ;; 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
|
1931 (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
|
1932 (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
|
1933 ;; 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
|
1934 (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
|
1935 (setq delayed-mode-hooks nil) |
57176
2da0a6d97b14
(run-mode-hooks): Run `after-change-major-mode-hook' after the
Luc Teirlinck <teirllm@auburn.edu>
parents:
57151
diff
changeset
|
1936 (apply 'run-hooks hooks) |
2da0a6d97b14
(run-mode-hooks): Run `after-change-major-mode-hook' after the
Luc Teirlinck <teirllm@auburn.edu>
parents:
57151
diff
changeset
|
1937 (run-hooks 'after-change-major-mode-hook))) |
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
|
1938 |
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 (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
|
1940 "Execute BODY, but delay any `run-mode-hooks'. |
57215
3bd3c7450f87
(delay-mode-hooks): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
57186
diff
changeset
|
1941 These hooks will be executed by the first following call to |
3bd3c7450f87
(delay-mode-hooks): Doc fix.
Luc Teirlinck <teirllm@auburn.edu>
parents:
57186
diff
changeset
|
1942 `run-mode-hooks' that occurs outside any `delayed-mode-hooks' form. |
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
|
1943 Only affects hooks run in the current buffer." |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
1944 (declare (debug t)) |
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
|
1945 `(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
|
1946 (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
|
1947 (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
|
1948 ,@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
|
1949 |
41975
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1950 ;; 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
|
1951 |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1952 (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
|
1953 "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
|
1954 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
|
1955 (let ((parent major-mode)) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1956 (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
|
1957 (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
|
1958 parent)) |
2b1145fdbe6e
(derived-mode-p): Moved here from derived.el.
Richard M. Stallman <rms@gnu.org>
parents:
41955
diff
changeset
|
1959 |
56826
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1960 (defun find-tag-default () |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1961 "Determine default tag to search for, based on text at point. |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1962 If there is no plausible default, return nil." |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1963 (save-excursion |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1964 (while (looking-at "\\sw\\|\\s_") |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1965 (forward-char 1)) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1966 (if (or (re-search-backward "\\sw\\|\\s_" |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1967 (save-excursion (beginning-of-line) (point)) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1968 t) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1969 (re-search-forward "\\(\\sw\\|\\s_\\)+" |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1970 (save-excursion (end-of-line) (point)) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1971 t)) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1972 (progn (goto-char (match-end 0)) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1973 (buffer-substring-no-properties |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1974 (point) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1975 (progn (forward-sexp -1) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1976 (while (looking-at "\\s'") |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1977 (forward-char 1)) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1978 (point)))) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1979 nil))) |
c5624ad1554b
(find-tag-default): Moved from etags.el.
Richard M. Stallman <rms@gnu.org>
parents:
56738
diff
changeset
|
1980 |
27297
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1981 (defmacro with-syntax-table (table &rest body) |
49888
c0dd4de41e91
(with-syntax-table): Don't copy the table any more.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49597
diff
changeset
|
1982 "Evaluate BODY with syntax table of current buffer set to TABLE. |
27297
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1983 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
|
1984 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
|
1985 Value is what BODY returns." |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
1986 (declare (debug t)) |
27384
a10a13dd0670
(with-syntax-table): Use make-symbol, not gensym.
Richard M. Stallman <rms@gnu.org>
parents:
27383
diff
changeset
|
1987 (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
|
1988 (old-buffer (make-symbol "buffer"))) |
27297
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1989 `(let ((,old-table (syntax-table)) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1990 (,old-buffer (current-buffer))) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1991 (unwind-protect |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1992 (progn |
49888
c0dd4de41e91
(with-syntax-table): Don't copy the table any more.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
49597
diff
changeset
|
1993 (set-syntax-table ,table) |
27297
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1994 ,@body) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1995 (save-current-buffer |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1996 (set-buffer ,old-buffer) |
f5713c397636
(with-syntax-table): Moved from simple.el.
Richard M. Stallman <rms@gnu.org>
parents:
26084
diff
changeset
|
1997 (set-syntax-table ,old-table)))))) |
51695
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
1998 |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
1999 (defmacro dynamic-completion-table (fun) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2000 "Use function FUN as a dynamic completion table. |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2001 FUN is called with one argument, the string for which completion is required, |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2002 and it should return an alist containing all the intended possible |
51980
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2003 completions. This alist may be a full list of possible completions so that FUN |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2004 can ignore the value of its argument. If completion is performed in the |
51695
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2005 minibuffer, FUN will be called in the buffer from which the minibuffer was |
51980
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2006 entered. |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2007 |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2008 The result of the `dynamic-completion-table' form is a function |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2009 that can be used as the ALIST argument to `try-completion' and |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2010 `all-completion'. See Info node `(elisp)Programmed Completion'." |
51695
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2011 (let ((win (make-symbol "window")) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2012 (string (make-symbol "string")) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2013 (predicate (make-symbol "predicate")) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2014 (mode (make-symbol "mode"))) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2015 `(lambda (,string ,predicate ,mode) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2016 (with-current-buffer (let ((,win (minibuffer-selected-window))) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2017 (if (window-live-p ,win) (window-buffer ,win) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2018 (current-buffer))) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2019 (cond |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2020 ((eq ,mode t) (all-completions ,string (,fun ,string) ,predicate)) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2021 ((not ,mode) (try-completion ,string (,fun ,string) ,predicate)) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2022 (t (test-completion ,string (,fun ,string) ,predicate))))))) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2023 |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2024 (defmacro lazy-completion-table (var fun &rest args) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2025 "Initialize variable VAR as a lazy completion table. |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2026 If the completion table VAR is used for the first time (e.g., by passing VAR |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2027 as an argument to `try-completion'), the function FUN is called with arguments |
51980
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2028 ARGS. FUN must return the completion table that will be stored in VAR. |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2029 If completion is requested in the minibuffer, FUN will be called in the buffer |
b7fa62a1a49d
(with-selected-window): Copy code form save-selected-window
Richard M. Stallman <rms@gnu.org>
parents:
51817
diff
changeset
|
2030 from which the minibuffer was entered. The return value of |
51695
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2031 `lazy-completion-table' must be used to initialize the value of VAR." |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2032 (let ((str (make-symbol "string"))) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2033 `(dynamic-completion-table |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2034 (lambda (,str) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2035 (unless (listp ,var) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2036 (setq ,var (funcall ',fun ,@args))) |
3e0f0ad2d93d
(lazy-completion-table, dynamic-completion-table): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
51611
diff
changeset
|
2037 ,var)))) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2038 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2039 ;;; Matching and substitution |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2040 |
15955
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
2041 (defvar save-match-data-internal) |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
2042 |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
2043 ;; 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
|
2044 ;; 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
|
2045 ;; 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
|
2046 ;; 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
|
2047 (defmacro save-match-data (&rest body) |
43527
d51d403fd80a
(save-match-data): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
43498
diff
changeset
|
2048 "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
|
2049 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
|
2050 ;; It is better not to use backquote here, |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2051 ;; because that makes a bootstrapping problem |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2052 ;; if you need to recompile all the Lisp files using interpreted code. |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2053 (declare (indent 0) (debug t)) |
26084
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2054 (list 'let |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2055 '((save-match-data-internal (match-data))) |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2056 (list 'unwind-protect |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2057 (cons 'progn body) |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2058 '(set-match-data save-match-data-internal)))) |
144
535ec1aa78ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
114
diff
changeset
|
2059 |
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
|
2060 (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
|
2061 "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
|
2062 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
|
2063 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
|
2064 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
|
2065 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
|
2066 (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
|
2067 (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
|
2068 (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
|
2069 (buffer-substring (match-beginning num) (match-end num))))) |
10560
fd09d51dfd77
(match-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10368
diff
changeset
|
2070 |
20491
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2071 (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
|
2072 "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
|
2073 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
|
2074 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
|
2075 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
|
2076 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
|
2077 (if (match-beginning num) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2078 (if string |
53994
342806d7b32b
(match-string-no-properties): Use substring-no-properties.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53626
diff
changeset
|
2079 (substring-no-properties string (match-beginning num) |
342806d7b32b
(match-string-no-properties): Use substring-no-properties.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53626
diff
changeset
|
2080 (match-end num)) |
20491
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2081 (buffer-substring-no-properties (match-beginning num) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2082 (match-end num))))) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2083 |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
2084 (defun looking-back (regexp &optional limit) |
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
2085 "Return non-nil if text before point matches regular expression REGEXP. |
57523
a2d6c6e6486a
(looking-back): Return only t or nil.
Richard M. Stallman <rms@gnu.org>
parents:
57480
diff
changeset
|
2086 Like `looking-at' except matches before point, and is slower. |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
2087 LIMIT if non-nil speeds up the search by specifying how far back the |
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
2088 match can start." |
57523
a2d6c6e6486a
(looking-back): Return only t or nil.
Richard M. Stallman <rms@gnu.org>
parents:
57480
diff
changeset
|
2089 (not (null |
a2d6c6e6486a
(looking-back): Return only t or nil.
Richard M. Stallman <rms@gnu.org>
parents:
57480
diff
changeset
|
2090 (save-excursion |
a2d6c6e6486a
(looking-back): Return only t or nil.
Richard M. Stallman <rms@gnu.org>
parents:
57480
diff
changeset
|
2091 (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t))))) |
51339
14976a545668
(looking-back): New function to check for regular expression before point.
Juanma Barranquero <lekktu@gmail.com>
parents:
51148
diff
changeset
|
2092 |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2093 (defconst split-string-default-separators "[ \f\t\n\r\v]+" |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2094 "The default value of separators for `split-string'. |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2095 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2096 A regexp matching strings of whitespace. May be locale-dependent |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2097 \(as yet unimplemented). Should not match non-breaking spaces. |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2098 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2099 Warning: binding this to a different value and using it as default is |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2100 likely to have undesired semantics.") |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2101 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2102 ;; The specification says that if both SEPARATORS and OMIT-NULLS are |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2103 ;; defaulted, OMIT-NULLS should be treated as t. Simplifying the logical |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2104 ;; expression leads to the equivalent implementation that if SEPARATORS |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2105 ;; is defaulted, OMIT-NULLS is treated as t. |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2106 (defun split-string (string &optional separators omit-nulls) |
57006
a806a6bbc178
(split-string): Docfix.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
56826
diff
changeset
|
2107 "Split STRING into substrings bounded by matches for SEPARATORS. |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2108 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2109 The beginning and end of STRING, and each match for SEPARATORS, are |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2110 splitting points. The substrings matching SEPARATORS are removed, and |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2111 the substrings between the splitting points are collected as a list, |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2112 which is returned. |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2113 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2114 If SEPARATORS is non-nil, it should be a regular expression matching text |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2115 which separates, but is not part of, the substrings. If nil it defaults to |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2116 `split-string-default-separators', normally \"[ \\f\\t\\n\\r\\v]+\", and |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2117 OMIT-NULLS is forced to t. |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2118 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
2119 If OMIT-NULLS is t, zero-length substrings are omitted from the list \(so |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2120 that for the default value of SEPARATORS leading and trailing whitespace |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2121 are effectively trimmed). If nil, all zero-length substrings are retained, |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2122 which correctly parses CSV format, for example. |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2123 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2124 Note that the effect of `(split-string STRING)' is the same as |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2125 `(split-string STRING split-string-default-separators t)'). In the rare |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2126 case that you wish to retain zero-length substrings when splitting on |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2127 whitespace, use `(split-string STRING split-string-default-separators)'. |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2128 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2129 Modifies the match data; use `save-match-data' if necessary." |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2130 (let ((keep-nulls (not (if separators omit-nulls t))) |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2131 (rexp (or separators split-string-default-separators)) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2132 (start 0) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2133 notfirst |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2134 (list nil)) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2135 (while (and (string-match rexp string |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2136 (if (and notfirst |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2137 (= start (match-beginning 0)) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2138 (< start (length string))) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2139 (1+ start) start)) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2140 (< start (length string))) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
2141 (setq notfirst t) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2142 (if (or keep-nulls (< start (match-beginning 0))) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2143 (setq list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2144 (cons (substring string start (match-beginning 0)) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2145 list))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2146 (setq start (match-end 0))) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2147 (if (or keep-nulls (< start (length string))) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2148 (setq list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2149 (cons (substring string start) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2150 list))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
2151 (nreverse list))) |
24089
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
2152 |
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
2153 (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
|
2154 "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
|
2155 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
|
2156 (let ((i (length string)) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
2157 (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
|
2158 (while (> i 0) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
2159 (setq i (1- i)) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
2160 (if (eq (aref newstr i) fromchar) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
2161 (aset newstr i tochar))) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
2162 newstr)) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2163 |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
2164 (defun replace-regexp-in-string (regexp rep string &optional |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2165 fixedcase literal subexp start) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2166 "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
|
2167 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2168 Return a new string containing the replacements. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2169 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2170 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
|
2171 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
|
2172 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
|
2173 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2174 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
|
2175 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
|
2176 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
|
2177 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
|
2178 |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
2179 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
|
2180 and replace a sub-expression, e.g. |
48077
69077a78e52f
(replace-regexp-in-string): Doc fix.
Andreas Schwab <schwab@suse.de>
parents:
47916
diff
changeset
|
2181 (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1) |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
2182 => \" bar foo\" |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
2183 " |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2184 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2185 ;; 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
|
2186 ;; 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
|
2187 ;; 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
|
2188 ;; 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
|
2189 ;; 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
|
2190 ;; [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
|
2191 ;; 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
|
2192 ;; 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
|
2193 ;; 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
|
2194 (let ((l (length string)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2195 (start (or start 0)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2196 matches str mb me) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2197 (save-match-data |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2198 (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
|
2199 (setq mb (match-beginning 0) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2200 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
|
2201 ;; 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
|
2202 (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
|
2203 ;; 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
|
2204 ;; 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
|
2205 ;; 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
|
2206 ;; 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
|
2207 ;; 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
|
2208 (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
|
2209 (setq matches |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
2210 (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
|
2211 rep |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
2212 (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
|
2213 fixedcase literal str subexp) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2214 (cons (substring string start mb) ; unmatched prefix |
28065
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
2215 matches))) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
2216 (setq start me)) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2217 ;; Reconstruct a string from the pieces. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
2218 (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
|
2219 (apply #'concat (nreverse matches))))) |
58800
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2220 |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2221 (defun subregexp-context-p (regexp pos &optional start) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2222 "Return non-nil if POS is in a normal subregexp context in REGEXP. |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2223 A subregexp context is one where a sub-regexp can appear. |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2224 A non-subregexp context is for example within brackets, or within a repetition |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2225 bounds operator \\{..\\}, or right after a \\. |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2226 If START is non-nil, it should be a position in REGEXP, smaller than POS, |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2227 and known to be in a subregexp context." |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2228 ;; Here's one possible implementation, with the great benefit that it |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2229 ;; reuses the regexp-matcher's own parser, so it understands all the |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2230 ;; details of the syntax. A disadvantage is that it needs to match the |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2231 ;; error string. |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2232 (condition-case err |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2233 (progn |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2234 (string-match (substring regexp (or start 0) pos) "") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2235 t) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2236 (invalid-regexp |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2237 (not (member (cadr err) '("Unmatched [ or [^" |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2238 "Unmatched \\{" |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2239 "Trailing backslash"))))) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2240 ;; An alternative implementation: |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2241 ;; (defconst re-context-re |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2242 ;; (let* ((harmless-ch "[^\\[]") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2243 ;; (harmless-esc "\\\\[^{]") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2244 ;; (class-harmless-ch "[^][]") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2245 ;; (class-lb-harmless "[^]:]") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2246 ;; (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2247 ;; (class-lb (concat "\\[\\(" class-lb-harmless |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2248 ;; "\\|" class-lb-colon-maybe-charclass "\\)")) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2249 ;; (class |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2250 ;; (concat "\\[^?]?" |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2251 ;; "\\(" class-harmless-ch |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2252 ;; "\\|" class-lb "\\)*" |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2253 ;; "\\[?]")) ; special handling for bare [ at end of re |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2254 ;; (braces "\\\\{[0-9,]+\\\\}")) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2255 ;; (concat "\\`\\(" harmless-ch "\\|" harmless-esc |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2256 ;; "\\|" class "\\|" braces "\\)*\\'")) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2257 ;; "Matches any prefix that corresponds to a normal subregexp context.") |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2258 ;; (string-match re-context-re (substring regexp (or start 0) pos)) |
212f5b190a89
(subregexp-context-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58460
diff
changeset
|
2259 ) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
2260 |
5385
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
2261 (defun shell-quote-argument (argument) |
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
2262 "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
|
2263 (if (eq system-type 'ms-dos) |
25706
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2264 ;; 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
|
2265 ;; the argument with backslashes. |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2266 (let ((result "") |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2267 (start 0) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2268 end) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2269 (if (or (null (string-match "[^\"]" argument)) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2270 (< (match-end 0) (length argument))) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2271 (while (string-match "[\"]" argument start) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2272 (setq end (match-beginning 0) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2273 result (concat result (substring argument start end) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2274 "\\" (substring argument end (1+ end))) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2275 start (1+ end)))) |
498eb90e1723
(shell-quote-argument): Quote argument with double
Eli Zaretskii <eliz@gnu.org>
parents:
25631
diff
changeset
|
2276 (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
|
2277 (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
|
2278 (concat "\"" argument "\"") |
17610
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2279 (if (equal argument "") |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2280 "''" |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2281 ;; Quote everything except POSIX filename characters. |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2282 ;; 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
|
2283 (let ((result "") (start 0) end) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2284 (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
|
2285 (setq end (match-beginning 0) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2286 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
|
2287 "\\" (substring argument end (1+ end))) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2288 start (1+ end))) |
f95fbf6f1234
(shell-quote-argument): Quote null string usefully.
Richard M. Stallman <rms@gnu.org>
parents:
17437
diff
changeset
|
2289 (concat result (substring argument start))))))) |
5385
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
2290 |
5844
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents:
5460
diff
changeset
|
2291 (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
|
2292 "Return a new syntax table. |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2293 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
|
2294 from `standard-syntax-table' otherwise." |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2295 (let ((table (make-char-table 'syntax-table nil))) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2296 (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
|
2297 table)) |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2298 |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
2299 (defun syntax-after (pos) |
58416
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
2300 "Return the raw syntax of the char after POS." |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
2301 (unless (or (< pos (point-min)) (>= pos (point-max))) |
58416
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
2302 (let ((st (if parse-sexp-lookup-properties |
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
2303 (get-char-property pos 'syntax-table)))) |
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
2304 (if (consp st) st |
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
2305 (aref (or st (syntax-table)) (char-after pos)))))) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
2306 |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2307 (defun add-to-invisibility-spec (arg) |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2308 "Add elements to `buffer-invisibility-spec'. |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2309 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
|
2310 that can be added." |
48935
6047d93c991e
(add-to-invisibility-spec): If it was t, start it out at (t).
Richard M. Stallman <rms@gnu.org>
parents:
48475
diff
changeset
|
2311 (if (eq buffer-invisibility-spec t) |
6047d93c991e
(add-to-invisibility-spec): If it was t, start it out at (t).
Richard M. Stallman <rms@gnu.org>
parents:
48475
diff
changeset
|
2312 (setq buffer-invisibility-spec (list t))) |
6047d93c991e
(add-to-invisibility-spec): If it was t, start it out at (t).
Richard M. Stallman <rms@gnu.org>
parents:
48475
diff
changeset
|
2313 (setq buffer-invisibility-spec |
6047d93c991e
(add-to-invisibility-spec): If it was t, start it out at (t).
Richard M. Stallman <rms@gnu.org>
parents:
48475
diff
changeset
|
2314 (cons arg buffer-invisibility-spec))) |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2315 |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2316 (defun remove-from-invisibility-spec (arg) |
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2317 "Remove elements from `buffer-invisibility-spec'." |
24245
418feab1639c
*** empty log message ***
Dan Nicolaescu <done@ece.arizona.edu>
parents:
24089
diff
changeset
|
2318 (if (consp buffer-invisibility-spec) |
17152 | 2319 (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
|
2320 |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2321 (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
|
2322 "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
|
2323 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
|
2324 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
|
2325 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
|
2326 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
|
2327 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
|
2328 |
af925352116e
(global-set-key, local-set-key): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
19662
diff
changeset
|
2329 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
|
2330 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
|
2331 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
|
2332 (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
|
2333 (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
|
2334 (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
|
2335 (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
|
2336 |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2337 (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
|
2338 "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
|
2339 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
|
2340 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
|
2341 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
|
2342 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
|
2343 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
|
2344 |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2345 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
|
2346 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
|
2347 (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
|
2348 (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
|
2349 (or map |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2350 (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
|
2351 (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
|
2352 (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
|
2353 (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
|
2354 |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2355 (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
|
2356 "Remove global binding of KEY. |
56625
d9455bfd01ee
(global-unset-key, local-unset-key): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56570
diff
changeset
|
2357 KEY is a string or vector representing a sequence of keystrokes." |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2358 (interactive "kUnset key globally: ") |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2359 (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
|
2360 |
10826
bd0ab0601489
(local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents:
10825
diff
changeset
|
2361 (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
|
2362 "Remove local binding of KEY. |
56625
d9455bfd01ee
(global-unset-key, local-unset-key): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56570
diff
changeset
|
2363 KEY is a string or vector representing a sequence of keystrokes." |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2364 (interactive "kUnset key locally: ") |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2365 (if (current-local-map) |
10826
bd0ab0601489
(local-unset-key): Fix args in previous change.
Karl Heuer <kwzh@gnu.org>
parents:
10825
diff
changeset
|
2366 (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
|
2367 nil) |
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
2368 |
12016
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
2369 ;; 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
|
2370 ;; 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
|
2371 (defun frame-configuration-p (object) |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
2372 "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
|
2373 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
|
2374 configuration." |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
2375 (and (consp object) |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
2376 (eq (car object) 'frame-configuration))) |
3fd7ef954be6
(frame-configuration-p): Moved here from frame.el.
Karl Heuer <kwzh@gnu.org>
parents:
11640
diff
changeset
|
2377 |
17418
726a87ac1486
(functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17215
diff
changeset
|
2378 (defun functionp (object) |
53485 | 2379 "Non-nil if OBJECT is any kind of function or a special form. |
2380 Also non-nil if OBJECT is a symbol and its function definition is | |
2381 \(recursively) a function or special form. This does not include | |
2382 macros." | |
41140
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
2383 (or (and (symbolp object) (fboundp object) |
45246
aec4852e765a
(functionp): Catch errors in indirect-function.
Richard M. Stallman <rms@gnu.org>
parents:
45078
diff
changeset
|
2384 (condition-case nil |
aec4852e765a
(functionp): Catch errors in indirect-function.
Richard M. Stallman <rms@gnu.org>
parents:
45078
diff
changeset
|
2385 (setq object (indirect-function object)) |
aec4852e765a
(functionp): Catch errors in indirect-function.
Richard M. Stallman <rms@gnu.org>
parents:
45078
diff
changeset
|
2386 (error nil)) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2387 (eq (car-safe object) 'autoload) |
41187
f3b21013637a
(functionp): Do use cdr-safe on object.
Richard M. Stallman <rms@gnu.org>
parents:
41140
diff
changeset
|
2388 (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
|
2389 (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
|
2390 (eq (car-safe object) 'lambda))) |
17418
726a87ac1486
(functionp): New function.
Richard M. Stallman <rms@gnu.org>
parents:
17215
diff
changeset
|
2391 |
27908
1c1e1ebca7f8
(assq-delete-all): Renamed from assoc-delete-all.
Gerd Moellmann <gerd@gnu.org>
parents:
27821
diff
changeset
|
2392 (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
|
2393 "Delete from ALIST all elements whose car is KEY. |
50694
fc93ef4196d1
(assq-delete-all): Ignore non-cons elememts.
Richard M. Stallman <rms@gnu.org>
parents:
50506
diff
changeset
|
2394 Return the modified alist. |
fc93ef4196d1
(assq-delete-all): Ignore non-cons elememts.
Richard M. Stallman <rms@gnu.org>
parents:
50506
diff
changeset
|
2395 Elements of ALIST that are not conses are ignored." |
25140
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
2396 (let ((tail alist)) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
2397 (while tail |
50694
fc93ef4196d1
(assq-delete-all): Ignore non-cons elememts.
Richard M. Stallman <rms@gnu.org>
parents:
50506
diff
changeset
|
2398 (if (and (consp (car tail)) (eq (car (car tail)) key)) |
25140
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
2399 (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
|
2400 (setq tail (cdr tail))) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
2401 alist)) |
e4493f0697ae
(assoc-delete-all): New function, renamed from frame-delete-all.
Dave Love <fx@gnu.org>
parents:
24757
diff
changeset
|
2402 |
44945
27acb2b2a2a9
(make-temp-file): New arg SUFFIX.
Richard M. Stallman <rms@gnu.org>
parents:
44900
diff
changeset
|
2403 (defun make-temp-file (prefix &optional dir-flag suffix) |
25631
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
2404 "Create a temporary file. |
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
2405 The returned file name (created by appending some random characters at the end |
45978
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
2406 of PREFIX, and expanding against `temporary-file-directory' if necessary), |
25631
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
2407 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
|
2408 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
|
2409 |
44945
27acb2b2a2a9
(make-temp-file): New arg SUFFIX.
Richard M. Stallman <rms@gnu.org>
parents:
44900
diff
changeset
|
2410 If DIR-FLAG is non-nil, create a new empty directory instead of a file. |
27acb2b2a2a9
(make-temp-file): New arg SUFFIX.
Richard M. Stallman <rms@gnu.org>
parents:
44900
diff
changeset
|
2411 |
27acb2b2a2a9
(make-temp-file): New arg SUFFIX.
Richard M. Stallman <rms@gnu.org>
parents:
44900
diff
changeset
|
2412 If SUFFIX is non-nil, add that at the end of the file name." |
47652
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2413 (let ((umask (default-file-modes)) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2414 file) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2415 (unwind-protect |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2416 (progn |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2417 ;; Create temp files with strict access rights. It's easy to |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2418 ;; loosen them later, whereas it's impossible to close the |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2419 ;; time-window of loose permissions otherwise. |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2420 (set-default-file-modes ?\700) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2421 (while (condition-case () |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2422 (progn |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2423 (setq file |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2424 (make-temp-name |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2425 (expand-file-name prefix temporary-file-directory))) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2426 (if suffix |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2427 (setq file (concat file suffix))) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2428 (if dir-flag |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2429 (make-directory file) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2430 (write-region "" nil file nil 'silent nil 'excl)) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2431 nil) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2432 (file-already-exists t)) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2433 ;; the file was somehow created by someone else between |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2434 ;; `make-temp-name' and `write-region', let's try again. |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2435 nil) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2436 file) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2437 ;; Reset the umask. |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2438 (set-default-file-modes umask)))) |
25631
0987f52a0674
(make-temp-file): New function.
Richard M. Stallman <rms@gnu.org>
parents:
25580
diff
changeset
|
2439 |
28720
f8379b011476
(add-minor-mode): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28628
diff
changeset
|
2440 |
50506
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2441 ;; If a minor mode is not defined with define-minor-mode, |
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2442 ;; add it here explicitly. |
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2443 ;; isearch-mode is deliberately excluded, since you should |
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2444 ;; not call it yourself. |
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2445 (defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode |
53063
5ce618af4f38
(minor-mode-list): Add `hs-minor-mode'.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52987
diff
changeset
|
2446 overwrite-mode view-mode |
5ce618af4f38
(minor-mode-list): Add `hs-minor-mode'.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
52987
diff
changeset
|
2447 hs-minor-mode) |
50506
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2448 "List of all minor mode functions.") |
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2449 |
28751 | 2450 (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
|
2451 "Register a new minor mode. |
28751 | 2452 |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2453 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
|
2454 |
28751 | 2455 TOGGLE is a symbol which is the name of a buffer-local variable that |
2456 is toggled on or off to say whether the minor mode is active or not. | |
2457 | |
2458 NAME specifies what will appear in the mode line when the minor mode | |
2459 is active. NAME should be either a string starting with a space, or a | |
2460 symbol whose value is such a string. | |
2461 | |
2462 Optional KEYMAP is the keymap for the minor mode that will be added | |
2463 to `minor-mode-map-alist'. | |
2464 | |
2465 Optional AFTER specifies that TOGGLE should be added after AFTER | |
2466 in `minor-mode-alist'. | |
2467 | |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2468 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
|
2469 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
|
2470 |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2471 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
|
2472 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
|
2473 If TOGGLE has a `:menu-tag', that is used for the menu item's label." |
50506
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2474 (unless (memq toggle minor-mode-list) |
6cc9a6c84a94
(minor-mode-list): New variable.
Richard M. Stallman <rms@gnu.org>
parents:
50449
diff
changeset
|
2475 (push toggle minor-mode-list)) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
2476 |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2477 (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
|
2478 ;; Add the name to the minor-mode-alist. |
28751 | 2479 (when name |
31979
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2480 (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
|
2481 (if existing |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2482 (setcdr existing (list name)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2483 (let ((tail minor-mode-alist) found) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2484 (while (and tail (not found)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2485 (if (eq after (caar tail)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2486 (setq found tail) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2487 (setq tail (cdr tail)))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2488 (if found |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2489 (let ((rest (cdr found))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2490 (setcdr found nil) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2491 (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
|
2492 (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
|
2493 minor-mode-alist))))))) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2494 ;; 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
|
2495 (when (get toggle :included) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2496 (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
|
2497 (vector toggle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2498 (list 'menu-item |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2499 (concat |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2500 (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
|
2501 (if (stringp name) name (symbol-name toggle))) |
47652
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2502 (let ((mode-name (if (symbolp name) (symbol-value name)))) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2503 (if (and (stringp mode-name) (string-match "[^ ]+" mode-name)) |
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2504 (concat " (" (match-string 0 mode-name) ")")))) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2505 toggle-fun |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2506 :button (cons :toggle toggle)))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2507 |
47652
a5316596929f
(read-key-auxiliary-map): New var.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47406
diff
changeset
|
2508 ;; Add the map to the minor-mode-map-alist. |
28751 | 2509 (when keymap |
2510 (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
|
2511 (if existing |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2512 (setcdr existing keymap) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2513 (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
|
2514 (while (and tail (not found)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2515 (if (eq after (caar tail)) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2516 (setq found tail) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2517 (setq tail (cdr tail)))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2518 (if found |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2519 (let ((rest (cdr found))) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2520 (setcdr found nil) |
6085a3297ebc
(add-minor-mode): Don't eval NAME.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
31563
diff
changeset
|
2521 (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
|
2522 (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
|
2523 minor-mode-map-alist)))))))) |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2524 |
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
|
2525 ;; 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
|
2526 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2527 (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
|
2528 "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
|
2529 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
|
2530 (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
|
2531 (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
|
2532 (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
|
2533 (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
|
2534 (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
|
2535 (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
|
2536 (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
|
2537 ;; 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
|
2538 (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
|
2539 (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
|
2540 (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
|
2541 (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
|
2542 (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
|
2543 (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
|
2544 ;; 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
|
2545 (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
|
2546 (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
|
2547 ;; 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
|
2548 (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
|
2549 (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
|
2550 (+ (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
|
2551 (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
|
2552 ;; 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
|
2553 (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
|
2554 (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
|
2555 (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
|
2556 ;; 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
|
2557 (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
|
2558 (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
|
2559 (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
|
2560 (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
|
2561 (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
|
2562 (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
|
2563 (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
|
2564 (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
|
2565 (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
|
2566 (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
|
2567 ;;(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
|
2568 (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
|
2569 (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
|
2570 (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
|
2571 (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
|
2572 ;;(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
|
2573 )))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2574 (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
|
2575 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2576 (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
|
2577 "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
|
2578 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
|
2579 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
|
2580 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
2581 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
|
2582 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
|
2583 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
|
2584 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
|
2585 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
|
2586 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
|
2587 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
|
2588 ;; 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
|
2589 ;; 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
|
2590 ;; (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
|
2591 ;; 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
|
2592 ;; 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
|
2593 ;; 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
|
2594 ;; `evaporate' to make sure those overlays get deleted when needed). |
47916 | 2595 ;; |
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
|
2596 (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
|
2597 (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
|
2598 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
|
2599 (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
|
2600 (>= 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
|
2601 (>= 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
|
2602 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
|
2603 (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
|
2604 (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
|
2605 (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
|
2606 (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
|
2607 (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
|
2608 (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
|
2609 ;;(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
|
2610 (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
|
2611 (overlay-put ol1 'text-clones dups) |
47916 | 2612 ;; |
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
|
2613 (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
|
2614 (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
|
2615 (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
|
2616 ;;(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
|
2617 (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
|
2618 (overlay-put ol2 'text-clones dups))) |
47406
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2619 |
44422
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2620 (defun play-sound (sound) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2621 "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
|
2622 The following keywords are recognized: |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2623 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2624 :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
|
2625 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
|
2626 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2627 :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
|
2628 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2629 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
|
2630 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2631 :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
|
2632 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
|
2633 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
|
2634 |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2635 :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
|
2636 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
|
2637 (unless (fboundp 'play-sound-internal) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2638 (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
|
2639 (play-sound-internal sound)) |
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
2640 |
47406
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2641 (defun define-mail-user-agent (symbol composefunc sendfunc |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2642 &optional abortfunc hookvar) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2643 "Define a symbol to identify a mail-sending package for `mail-user-agent'. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2644 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2645 SYMBOL can be any Lisp symbol. Its function definition and/or |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2646 value as a variable do not matter for this usage; we use only certain |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2647 properties on its property list, to encode the rest of the arguments. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2648 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2649 COMPOSEFUNC is program callable function that composes an outgoing |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2650 mail message buffer. This function should set up the basics of the |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2651 buffer without requiring user interaction. It should populate the |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2652 standard mail headers, leaving the `to:' and `subject:' headers blank |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2653 by default. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2654 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2655 COMPOSEFUNC should accept several optional arguments--the same |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2656 arguments that `compose-mail' takes. See that function's documentation. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2657 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2658 SENDFUNC is the command a user would run to send the message. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2659 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2660 Optional ABORTFUNC is the command a user would run to abort the |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2661 message. For mail packages that don't have a separate abort function, |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2662 this can be `kill-buffer' (the equivalent of omitting this argument). |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2663 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2664 Optional HOOKVAR is a hook variable that gets run before the message |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2665 is actually sent. Callers that use the `mail-user-agent' may |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2666 install a hook function temporarily on this hook variable. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2667 If HOOKVAR is nil, `mail-send-hook' is used. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2668 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2669 The properties used on SYMBOL are `composefunc', `sendfunc', |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2670 `abortfunc', and `hookvar'." |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2671 (put symbol 'composefunc composefunc) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2672 (put symbol 'sendfunc sendfunc) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2673 (put symbol 'abortfunc (or abortfunc 'kill-buffer)) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2674 (put symbol 'hookvar (or hookvar 'mail-send-hook))) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
2675 |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2676 ;; Standardized progress reporting |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2677 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2678 ;; Progress reporter has the following structure: |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2679 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2680 ;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2681 ;; MIN-VALUE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2682 ;; MAX-VALUE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2683 ;; MESSAGE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2684 ;; MIN-CHANGE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2685 ;; MIN-TIME]) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2686 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2687 ;; This weirdeness is for optimization reasons: we want |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2688 ;; `progress-reporter-update' to be as fast as possible, so |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2689 ;; `(car reporter)' is better than `(aref reporter 0)'. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2690 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2691 ;; NEXT-UPDATE-TIME is a float. While `float-time' loses a couple |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2692 ;; digits of precision, it doesn't really matter here. On the other |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2693 ;; hand, it greatly simplifies the code. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2694 |
57408
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2695 (defsubst progress-reporter-update (reporter value) |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2696 "Report progress of an operation in the echo area. |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2697 However, if the change since last echo area update is too small |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2698 or not enough time has passed, then do nothing (see |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2699 `make-progress-reporter' for details). |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2700 |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2701 First parameter, REPORTER, should be the result of a call to |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2702 `make-progress-reporter'. Second, VALUE, determines the actual |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2703 progress of operation; it must be between MIN-VALUE and MAX-VALUE |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2704 as passed to `make-progress-reporter'. |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2705 |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2706 This function is very inexpensive, you may not bother how often |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2707 you call it." |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2708 (when (>= value (car reporter)) |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2709 (progress-reporter-do-update reporter value))) |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
2710 |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2711 (defun make-progress-reporter (message min-value max-value |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2712 &optional current-value |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2713 min-change min-time) |
59648
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2714 "Return progress reporter object to be used with `progress-reporter-update'. |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2715 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2716 MESSAGE is shown in the echo area. When at least 1% of operation |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2717 is complete, the exact percentage will be appended to the |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2718 MESSAGE. When you call `progress-reporter-done', word \"done\" |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2719 is printed after the MESSAGE. You can change MESSAGE of an |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2720 existing progress reporter with `progress-reporter-force-update'. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2721 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2722 MIN-VALUE and MAX-VALUE designate starting (0% complete) and |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2723 final (100% complete) states of operation. The latter should be |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2724 larger; if this is not the case, then simply negate all values. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2725 Optional CURRENT-VALUE specifies the progress by the moment you |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2726 call this function. You should omit it or set it to nil in most |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2727 cases since it defaults to MIN-VALUE. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2728 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2729 Optional MIN-CHANGE determines the minimal change in percents to |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2730 report (default is 1%.) Optional MIN-TIME specifies the minimal |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2731 time before echo area updates (default is 0.2 seconds.) If |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2732 `float-time' function is not present, then time is not tracked |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2733 at all. If OS is not capable of measuring fractions of seconds, |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2734 then this parameter is effectively rounded up." |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2735 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2736 (unless min-time |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2737 (setq min-time 0.2)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2738 (let ((reporter |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2739 (cons min-value ;; Force a call to `message' now |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2740 (vector (if (and (fboundp 'float-time) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2741 (>= min-time 0.02)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2742 (float-time) nil) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2743 min-value |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2744 max-value |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2745 message |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2746 (if min-change (max (min min-change 50) 1) 1) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2747 min-time)))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2748 (progress-reporter-update reporter (or current-value min-value)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2749 reporter)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2750 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2751 (defun progress-reporter-force-update (reporter value &optional new-message) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2752 "Report progress of an operation in the echo area unconditionally. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2753 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2754 First two parameters are the same as for |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2755 `progress-reporter-update'. Optional NEW-MESSAGE allows you to |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2756 change the displayed message." |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2757 (let ((parameters (cdr reporter))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2758 (when new-message |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2759 (aset parameters 3 new-message)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2760 (when (aref parameters 0) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2761 (aset parameters 0 (float-time))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2762 (progress-reporter-do-update reporter value))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2763 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2764 (defun progress-reporter-do-update (reporter value) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2765 (let* ((parameters (cdr reporter)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2766 (min-value (aref parameters 1)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2767 (max-value (aref parameters 2)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2768 (one-percent (/ (- max-value min-value) 100.0)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2769 (percentage (truncate (/ (- value min-value) one-percent))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2770 (update-time (aref parameters 0)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2771 (current-time (float-time)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2772 (enough-time-passed |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2773 ;; See if enough time has passed since the last update. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2774 (or (not update-time) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2775 (when (>= current-time update-time) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2776 ;; Calculate time for the next update |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2777 (aset parameters 0 (+ update-time (aref parameters 5))))))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2778 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2779 ;; Calculate NEXT-UPDATE-VALUE. If we are not going to print |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2780 ;; message this time because not enough time has passed, then use |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2781 ;; 1 instead of MIN-CHANGE. This makes delays between echo area |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2782 ;; updates closer to MIN-TIME. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2783 (setcar reporter |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2784 (min (+ min-value (* (+ percentage |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2785 (if enough-time-passed |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2786 (aref parameters 4) ;; MIN-CHANGE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2787 1)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2788 one-percent)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2789 max-value)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2790 (when (integerp value) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2791 (setcar reporter (ceiling (car reporter)))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2792 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2793 ;; Only print message if enough time has passed |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2794 (when enough-time-passed |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2795 (if (> percentage 0) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2796 (message "%s%d%%" (aref parameters 3) percentage) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2797 (message "%s" (aref parameters 3)))))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2798 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2799 (defun progress-reporter-done (reporter) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2800 "Print reporter's message followed by word \"done\" in echo area." |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2801 (message "%sdone" (aref (cdr reporter) 3))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
2802 |
59648
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2803 (defmacro dotimes-with-progress-reporter (spec message &rest body) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2804 "Loop a certain number of times and report progress in the echo area. |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2805 Evaluate BODY with VAR bound to successive integers running from |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2806 0, inclusive, to COUNT, exclusive. Then evaluate RESULT to get |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2807 the return value (nil if RESULT is omitted). |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2808 |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2809 At each iteration MESSAGE followed by progress percentage is |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2810 printed in the echo area. After the loop is finished, MESSAGE |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2811 followed by word \"done\" is printed. This macro is a |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2812 convenience wrapper around `make-progress-reporter' and friends. |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2813 |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2814 \(fn (VAR COUNT [RESULT]) MESSAGE BODY...)" |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2815 (declare (indent 2) (debug ((symbolp form &optional form) form body))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2816 (let ((temp (make-symbol "--dotimes-temp--")) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2817 (temp2 (make-symbol "--dotimes-temp2--")) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2818 (start 0) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2819 (end (nth 1 spec))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2820 `(let ((,temp ,end) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2821 (,(car spec) ,start) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2822 (,temp2 (make-progress-reporter ,message ,start ,end))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2823 (while (< ,(car spec) ,temp) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2824 ,@body |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2825 (progress-reporter-update ,temp2 |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2826 (setq ,(car spec) (1+ ,(car spec))))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2827 (progress-reporter-done ,temp2) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2828 nil ,@(cdr (cdr spec))))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
2829 |
57151
5350f17d0a78
(event-basic-type): Fix mask (extend to 22bits).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57148
diff
changeset
|
2830 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
2831 ;;; subr.el ends here |