Mercurial > emacs
annotate lisp/subr.el @ 108284:3ecfdde2a36c
Merge from mainline.
author | Katsumi Yamaoka <yamaoka@jpl.org> |
---|---|
date | Thu, 06 May 2010 06:11:19 +0000 |
parents | be3f6d650654 |
children | cd5442b2826b |
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, |
106815 | 4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc. |
114 | 5 |
45078 | 6 ;; Maintainer: FSF |
7 ;; Keywords: internal | |
8 | |
114 | 9 ;; This file is part of GNU Emacs. |
10 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94556
diff
changeset
|
11 ;; GNU Emacs is free software: you can redistribute it and/or modify |
114 | 12 ;; it under the terms of the GNU General Public License as published by |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94556
diff
changeset
|
13 ;; the Free Software Foundation, either version 3 of the License, or |
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94556
diff
changeset
|
14 ;; (at your option) any later version. |
114 | 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 | |
94678
ee5932bf781d
Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents:
94556
diff
changeset
|
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
114 | 23 |
38414
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37070
diff
changeset
|
24 ;;; Commentary: |
67b464da13ec
Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents:
37070
diff
changeset
|
25 |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
26 ;;; Code: |
98925
5813cf04cdfe
(top-level): Require `cl' when compiling.
Eli Zaretskii <eliz@gnu.org>
parents:
98907
diff
changeset
|
27 |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
28 (defvar custom-declare-variable-list nil |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
29 "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
|
30 Each element of this list holds the arguments to one call to `defcustom'.") |
114 | 31 |
19662 | 32 ;; 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
|
33 ;; before custom.el. |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
34 (defun custom-declare-variable-early (&rest arguments) |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
35 (setq custom-declare-variable-list |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
36 (cons arguments custom-declare-variable-list))) |
44129
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
37 |
87002
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
38 (defmacro declare-function (fn file &optional arglist fileonly) |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
39 "Tell the byte-compiler that function FN is defined, in FILE. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
40 Optional ARGLIST is the argument list used by the function. The |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
41 FILE argument is not used by the byte-compiler, but by the |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
42 `check-declare' package, which checks that FILE contains a |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
43 definition for FN. ARGLIST is used by both the byte-compiler and |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
44 `check-declare' to check for consistency. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
45 |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
46 FILE can be either a Lisp file (in which case the \".el\" |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
47 extension is optional), or a C file. C files are expanded |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
48 relative to the Emacs \"src/\" directory. Lisp files are |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
49 searched for using `locate-library', and if that fails they are |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
50 expanded relative to the location of the file containing the |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
51 declaration. A FILE with an \"ext:\" prefix is an external file. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
52 `check-declare' will check such files if they are found, and skip |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
53 them without error if they are not. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
54 |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
55 FILEONLY non-nil means that `check-declare' will only check that |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
56 FILE exists, not that it defines FN. This is intended for |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
57 function-definitions that `check-declare' does not recognize, e.g. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
58 `defstruct'. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
59 |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
60 To specify a value for FILEONLY without passing an argument list, |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
61 set ARGLIST to `t'. This is necessary because `nil' means an |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
62 empty argument list, rather than an unspecified one. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
63 |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
64 Note that for the purposes of `check-declare', this statement |
105317 | 65 must be the first non-whitespace on a line. |
87002
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
66 |
100388 | 67 For more information, see Info node `(elisp)Declaring Functions'." |
87002
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
68 ;; Does nothing - byte-compile-declare-function does the work. |
c6a200c4eebd
(declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents:
86341
diff
changeset
|
69 nil) |
98939 | 70 |
44129
444bd245e176
(macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents:
43833
diff
changeset
|
71 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
72 ;;;; Basic Lisp macros. |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
73 |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
74 (defalias 'not 'null) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
75 |
53197
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
76 (defmacro noreturn (form) |
67899
7c797468d04b
(noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
67876
diff
changeset
|
77 "Evaluate FORM, expecting it not to return. |
7c797468d04b
(noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
67876
diff
changeset
|
78 If FORM does return, signal an error." |
53197
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
79 `(prog1 ,form |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
80 (error "Form marked with `noreturn' did return"))) |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
81 |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
82 (defmacro 1value (form) |
67899
7c797468d04b
(noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
67876
diff
changeset
|
83 "Evaluate FORM, expecting a constant return value. |
7c797468d04b
(noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
67876
diff
changeset
|
84 This is the global do-nothing version. There is also `testcover-1value' |
7c797468d04b
(noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
67876
diff
changeset
|
85 that complains if FORM ever does return differing values." |
53197
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
86 form) |
61703d3393d6
Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents:
53181
diff
changeset
|
87 |
71726
a36e654643c1
(def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents:
71151
diff
changeset
|
88 (defmacro def-edebug-spec (symbol spec) |
a36e654643c1
(def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents:
71151
diff
changeset
|
89 "Set the `edebug-form-spec' property of SYMBOL according to SPEC. |
103884 | 90 Both SYMBOL and SPEC are unevaluated. The SPEC can be: |
91 0 (instrument no arguments); t (instrument all arguments); | |
92 a symbol (naming a function with an Edebug specification); or a list. | |
93 The elements of the list describe the argument types; see | |
94 \(info \"(elisp)Specification List\") for details." | |
71726
a36e654643c1
(def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents:
71151
diff
changeset
|
95 `(put (quote ,symbol) 'edebug-form-spec (quote ,spec))) |
a36e654643c1
(def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents:
71151
diff
changeset
|
96 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
97 (defmacro lambda (&rest cdr) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
98 "Return a lambda expression. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
99 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
|
100 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
|
101 expression itself. The lambda expression may then be treated as a |
10178 | 102 function, i.e., stored as the function value of a symbol, passed to |
63634
ec5194493ae9
(1value, lambda, key-substitution-in-progress): Doc fixes.
Juanma Barranquero <lekktu@gmail.com>
parents:
63605
diff
changeset
|
103 `funcall' or `mapcar', etc. |
10178 | 104 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
105 ARGS should take the same form as an argument list for a `defun'. |
12395 | 106 DOCSTRING is an optional documentation string. |
107 If present, it should describe how to call the function. | |
108 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
|
109 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
|
110 It may also be omitted. |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
111 BODY should be a list of Lisp expressions. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
112 |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
113 \(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
|
114 ;; 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
|
115 ;; depend on backquote.el. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
116 (list 'function (cons 'lambda cdr))) |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
117 |
105068
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
118 (if (null (featurep 'cl)) |
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
119 (progn |
105060
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
120 ;; If we reload subr.el after having loaded CL, be careful not to |
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
121 ;; overwrite CL's extended definition of `dolist', `dotimes', |
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
122 ;; `declare', `push' and `pop'. |
25437 | 123 (defmacro push (newelt listname) |
25580 | 124 "Add NEWELT to the list stored in the symbol LISTNAME. |
25437 | 125 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
|
126 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
|
127 (declare (debug (form sexp))) |
25469 | 128 (list 'setq listname |
105060
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
129 (list 'cons newelt listname))) |
25436
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
130 |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
131 (defmacro pop (listname) |
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
132 "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
|
133 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
|
134 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
|
135 change the list." |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
136 (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
|
137 (list 'car |
105060
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
138 (list 'prog1 listname |
105068
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
139 (list 'setq listname (list 'cdr listname))))) |
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
140 )) |
25436
d24cf1a4dd34
(push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents:
25295
diff
changeset
|
141 |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
142 (defmacro when (cond &rest body) |
76530 | 143 "If COND yields non-nil, do BODY, else return nil. |
144 When COND yields non-nil, eval BODY forms sequentially and return | |
145 value of last one, or nil if there are none. | |
146 | |
78149
677d96c34c87
(when, unless): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
78081
diff
changeset
|
147 \(fn COND BODY...)" |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
148 (declare (indent 1) (debug t)) |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
149 (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
|
150 |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
151 (defmacro unless (cond &rest body) |
76530 | 152 "If COND yields nil, do BODY, else return nil. |
153 When COND yields nil, eval BODY forms sequentially and return | |
154 value of last one, or nil if there are none. | |
155 | |
78149
677d96c34c87
(when, unless): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
78081
diff
changeset
|
156 \(fn COND BODY...)" |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
157 (declare (indent 1) (debug t)) |
16845
adc714dc8e3c
(when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
16556
diff
changeset
|
158 (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
|
159 |
105068
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
160 (if (null (featurep 'cl)) |
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
161 (progn |
105060
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
162 ;; If we reload subr.el after having loaded CL, be careful not to |
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
163 ;; overwrite CL's extended definition of `dolist', `dotimes', |
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
164 ;; `declare', `push' and `pop'. |
72096
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
165 (defvar --dolist-tail-- nil |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
166 "Temporary variable used in `dolist' expansion.") |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
167 |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
168 (defmacro dolist (spec &rest body) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
169 "Loop over a list. |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
170 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
|
171 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
|
172 |
51817
5e9d88e4fcff
(dolist, dotimes): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
51695
diff
changeset
|
173 \(fn (VAR LIST [RESULT]) BODY...)" |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
174 (declare (indent 1) (debug ((symbolp form &optional form) body))) |
72096
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
175 ;; It would be cleaner to create an uninterned symbol, |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
176 ;; but that uses a lot more space when many functions in many files |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
177 ;; use dolist. |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
178 (let ((temp '--dolist-tail--)) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
179 `(let ((,temp ,(nth 1 spec)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
180 ,(car spec)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
181 (while ,temp |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
182 (setq ,(car spec) (car ,temp)) |
72096
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
183 ,@body |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
184 (setq ,temp (cdr ,temp))) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
185 ,@(if (cdr (cdr spec)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
186 `((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
|
187 |
72096
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
188 (defvar --dotimes-limit-- nil |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
189 "Temporary variable used in `dotimes' expansion.") |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
190 |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
191 (defmacro dotimes (spec &rest body) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
192 "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
|
193 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
|
194 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
|
195 the return value (nil if RESULT is omitted). |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
196 |
51817
5e9d88e4fcff
(dolist, dotimes): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents:
51695
diff
changeset
|
197 \(fn (VAR COUNT [RESULT]) BODY...)" |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
198 (declare (indent 1) (debug dolist)) |
72096
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
199 ;; It would be cleaner to create an uninterned symbol, |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
200 ;; but that uses a lot more space when many functions in many files |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
201 ;; use dotimes. |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
202 (let ((temp '--dotimes-limit--) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
203 (start 0) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
204 (end (nth 1 spec))) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
205 `(let ((,temp ,end) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
206 (,(car spec) ,start)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
207 (while (< ,(car spec) ,temp) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
208 ,@body |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
209 (setq ,(car spec) (1+ ,(car spec)))) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
210 ,@(cdr (cdr spec))))) |
27376
674b7f75841e
(dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents:
27297
diff
changeset
|
211 |
53593 | 212 (defmacro declare (&rest specs) |
213 "Do not evaluate any arguments and return nil. | |
214 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
|
215 `defmacro' form. \(See Info anchor `(elisp)Definition of declare'.)" |
105068
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
216 nil) |
b97679d5a9af
* subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents:
105060
diff
changeset
|
217 )) |
94703
4520f20e7dd1
(ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
218 |
4520f20e7dd1
(ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
219 (defmacro ignore-errors (&rest body) |
4520f20e7dd1
(ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
220 "Execute BODY; if an error occurs, return nil. |
4520f20e7dd1
(ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
221 Otherwise, return result of last form in BODY." |
4520f20e7dd1
(ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents:
94678
diff
changeset
|
222 `(condition-case nil (progn ,@body) (error nil))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
223 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
224 ;;;; Basic Lisp functions. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
225 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
226 (defun ignore (&rest ignore) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
227 "Do nothing and return nil. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
228 This function accepts any number of arguments, but ignores them." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
229 (interactive) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
230 nil) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
231 |
105629
bdfcf9d2baaa
(error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105364
diff
changeset
|
232 ;; Signal a compile-error if the first arg is missing. |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
233 (defun error (&rest args) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
234 "Signal an error, making error message by passing all args to `format'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
235 In Emacs, the convention is that error messages start with a capital |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
236 letter but *do not* end with a period. Please follow this convention |
105629
bdfcf9d2baaa
(error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105364
diff
changeset
|
237 for the sake of consistency." |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
238 (while t |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
239 (signal 'error (list (apply 'format args))))) |
105631
7cea65998c1f
* subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105629
diff
changeset
|
240 (set-advertised-calling-convention 'error '(string &rest args)) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
241 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
242 ;; We put this here instead of in frame.el so that it's defined even on |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
243 ;; systems where frame.el isn't loaded. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
244 (defun frame-configuration-p (object) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
245 "Return non-nil if OBJECT seems to be a frame configuration. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
246 Any list whose car is `frame-configuration' is assumed to be a frame |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
247 configuration." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
248 (and (consp object) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
249 (eq (car object) 'frame-configuration))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
250 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
251 (defun functionp (object) |
93735
310118b32104
(functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93721
diff
changeset
|
252 "Non-nil if OBJECT is a function." |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
253 (or (and (symbolp object) (fboundp object) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
254 (condition-case nil |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
255 (setq object (indirect-function object)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
256 (error nil)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
257 (eq (car-safe object) 'autoload) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
258 (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object))))))) |
93735
310118b32104
(functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93721
diff
changeset
|
259 (and (subrp object) |
310118b32104
(functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93721
diff
changeset
|
260 ;; Filter out special forms. |
310118b32104
(functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93721
diff
changeset
|
261 (not (eq 'unevalled (cdr (subr-arity object))))) |
310118b32104
(functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93721
diff
changeset
|
262 (byte-code-function-p object) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
263 (eq (car-safe object) 'lambda))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
264 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
265 ;;;; List functions. |
53593 | 266 |
19491
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
267 (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
|
268 "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
|
269 (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
|
270 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
271 (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
|
272 "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
|
273 (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
|
274 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
275 (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
|
276 "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
|
277 (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
|
278 |
f5fd22f3462c
(caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents:
19176
diff
changeset
|
279 (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
|
280 "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
|
281 (cdr (cdr x))) |
19492 | 282 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
283 (defun last (list &optional n) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
284 "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
|
285 If LIST is nil, return nil. |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
286 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
|
287 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
|
288 (if n |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
289 (let ((m 0) (p list)) |
19584
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
290 (while (consp p) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
291 (setq m (1+ m) p (cdr p))) |
17db1ee36bbb
(last): Accept optional second argument.
Richard M. Stallman <rms@gnu.org>
parents:
19492
diff
changeset
|
292 (if (<= n 0) p |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
293 (if (< n m) (nthcdr (- m n) list) list))) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
294 (while (consp (cdr list)) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
295 (setq list (cdr list))) |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
296 list)) |
22860
349fa4ee1f27
(assoc-default): New function.
Richard M. Stallman <rms@gnu.org>
parents:
22755
diff
changeset
|
297 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
298 (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
|
299 "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
|
300 (if (and n (<= n 0)) list |
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
301 (nbutlast (copy-sequence list) n))) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
302 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
303 (defun nbutlast (list &optional n) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
304 "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
|
305 (let ((m (length list))) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
306 (or n (setq n 1)) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
307 (and (< n m) |
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
308 (progn |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
309 (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
|
310 list)))) |
34898
1486728b21f0
(butlast, nbutlast): Moved from cl.el to here.
Kenichi Handa <handa@m17n.org>
parents:
34853
diff
changeset
|
311 |
53626
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
312 (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
|
313 "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
|
314 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
|
315 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
|
316 one is kept." |
53626
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
317 (let ((tail list)) |
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
318 (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
|
319 (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
|
320 (setq tail (cdr tail)))) |
53626
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
321 list) |
ee432d9e3bbd
(delete-dups): New function.
Luc Teirlinck <teirllm@auburn.edu>
parents:
53593
diff
changeset
|
322 |
50449
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
323 (defun number-sequence (from &optional to inc) |
50415
b040b4e36f5e
(number-sequence): New function.
Kenichi Handa <handa@m17n.org>
parents:
50136
diff
changeset
|
324 "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
|
325 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
|
326 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
|
327 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
|
328 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
|
329 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
|
330 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
|
331 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
|
332 FROM, signal an error. |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
333 |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
334 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
|
335 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
|
336 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
|
337 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
|
338 \(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
|
339 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
|
340 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
|
341 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
|
342 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
|
343 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
|
344 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
|
345 \(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
|
346 (if (or (not to) (= from to)) |
50449
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
347 (list from) |
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
348 (or inc (setq inc 1)) |
53174
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
349 (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
|
350 (let (seq (n 0) (next from)) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
351 (if (> inc 0) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
352 (while (<= next to) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
353 (setq seq (cons next seq) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
354 n (1+ n) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
355 next (+ from (* n inc)))) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
356 (while (>= next to) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
357 (setq seq (cons next seq) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
358 n (1+ n) |
5f50db6e04c6
(number-sequence): Improve handling of floating point arguments
Luc Teirlinck <teirllm@auburn.edu>
parents:
53132
diff
changeset
|
359 next (+ from (* n inc))))) |
50449
f85be9da34a2
Adjust number-sequence code
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
50427
diff
changeset
|
360 (nreverse seq)))) |
50415
b040b4e36f5e
(number-sequence): New function.
Kenichi Handa <handa@m17n.org>
parents:
50136
diff
changeset
|
361 |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
362 (defun copy-tree (tree &optional vecp) |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
363 "Make a copy of TREE. |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
364 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
|
365 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
|
366 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
|
367 (if (consp tree) |
45740
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
368 (let (result) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
369 (while (consp tree) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
370 (let ((newcar (car tree))) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
371 (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
|
372 (setq newcar (copy-tree (car tree) vecp))) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
373 (push newcar result)) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
374 (setq tree (cdr tree))) |
45821
41129d3d126b
(copy-tree): Use `nconc' and `nreverse' instead of `nreconc'.
Miles Bader <miles@gnu.org>
parents:
45740
diff
changeset
|
375 (nconc (nreverse result) tree)) |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
376 (if (and vecp (vectorp tree)) |
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
377 (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
|
378 (while (>= (setq i (1- i)) 0) |
45740
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
379 (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
|
380 tree) |
4e576724db9f
(copy-list): Moved to cl.el.
Richard M. Stallman <rms@gnu.org>
parents:
45690
diff
changeset
|
381 tree))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
382 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
383 ;;;; Various list-search functions. |
45690
9d351e5869c8
(copy-list): Moved here from cl.el.
Colin Walters <walters@gnu.org>
parents:
45587
diff
changeset
|
384 |
22959
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
385 (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
|
386 "Find object KEY in a pseudo-alist ALIST. |
103107
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
387 ALIST is a list of conses or objects. Each element |
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
388 (or the element's car, if it is a cons) is compared with KEY by |
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
389 calling TEST, with two arguments: (i) the element or its car, |
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
390 and (ii) KEY. |
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
391 If that is non-nil, the element matches; then `assoc-default' |
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
392 returns the element's cdr, if it is a cons, or DEFAULT if the |
15fc92c2fca6
* subr.el (assoc-default): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
102983
diff
changeset
|
393 element is not a cons. |
22959
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
394 |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
395 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
|
396 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
|
397 (let (found (tail alist) value) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
398 (while (and tail (not found)) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
399 (let ((elt (car tail))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
400 (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
|
401 (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
|
402 (setq tail (cdr tail))) |
73a21b5f9bd8
(assoc-default): Rewrite not to use dolist.
Richard M. Stallman <rms@gnu.org>
parents:
22860
diff
changeset
|
403 value)) |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
404 |
93971
2d29453eb5e6
(assoc-ignore-case, assoc-ignore-representation):
Juanma Barranquero <lekktu@gmail.com>
parents:
93825
diff
changeset
|
405 (make-obsolete 'assoc-ignore-case 'assoc-string "22.1") |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
406 (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
|
407 "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
|
408 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
|
409 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
|
410 (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
|
411 |
93971
2d29453eb5e6
(assoc-ignore-case, assoc-ignore-representation):
Juanma Barranquero <lekktu@gmail.com>
parents:
93825
diff
changeset
|
412 (make-obsolete 'assoc-ignore-representation 'assoc-string "22.1") |
25295
737e82c21934
(assoc-ignore-case, assoc-ignore-representation): Moved here from simple.el.
Karl Heuer <kwzh@gnu.org>
parents:
25293
diff
changeset
|
413 (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
|
414 "Like `assoc', but ignores differences in text representation. |
47916 | 415 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
|
416 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
|
417 (assoc-string key alist nil)) |
28490
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
418 |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
419 (defun member-ignore-case (elt list) |
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
420 "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
|
421 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
|
422 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
|
423 Non-strings in LIST are ignored." |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
424 (while (and list |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
425 (not (and (stringp (car list)) |
e4975d9c93ff
(insert-for-yank): Replace `category' property
Richard M. Stallman <rms@gnu.org>
parents:
44723
diff
changeset
|
426 (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
|
427 (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
|
428 list) |
28490
9958b6d95bd6
(member-ignore-case): New function.
Gerd Moellmann <gerd@gnu.org>
parents:
28234
diff
changeset
|
429 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
430 (defun assq-delete-all (key alist) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
431 "Delete from ALIST all elements whose car is `eq' to KEY. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
432 Return the modified alist. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
433 Elements of ALIST that are not conses are ignored." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
434 (while (and (consp (car alist)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
435 (eq (car (car alist)) key)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
436 (setq alist (cdr alist))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
437 (let ((tail alist) tail-cdr) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
438 (while (setq tail-cdr (cdr tail)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
439 (if (and (consp (car tail-cdr)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
440 (eq (car (car tail-cdr)) key)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
441 (setcdr tail (cdr tail-cdr)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
442 (setq tail tail-cdr)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
443 alist) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
444 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
445 (defun rassq-delete-all (value alist) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
446 "Delete from ALIST all elements whose cdr is `eq' to VALUE. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
447 Return the modified alist. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
448 Elements of ALIST that are not conses are ignored." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
449 (while (and (consp (car alist)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
450 (eq (cdr (car alist)) value)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
451 (setq alist (cdr alist))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
452 (let ((tail alist) tail-cdr) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
453 (while (setq tail-cdr (cdr tail)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
454 (if (and (consp (car tail-cdr)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
455 (eq (cdr (car tail-cdr)) value)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
456 (setcdr tail (cdr tail-cdr)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
457 (setq tail tail-cdr)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
458 alist) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
459 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
460 (defun remove (elt seq) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
461 "Return a copy of SEQ with all occurrences of ELT removed. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
462 SEQ must be a list, vector, or string. The comparison is done with `equal'." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
463 (if (nlistp seq) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
464 ;; If SEQ isn't a list, there's no need to copy SEQ because |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
465 ;; `delete' will return a new object. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
466 (delete elt seq) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
467 (delete elt (copy-sequence seq)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
468 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
469 (defun remq (elt list) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
470 "Return LIST with all occurrences of ELT removed. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
471 The comparison is done with `eq'. Contrary to `delq', this does not use |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
472 side-effects, and the argument LIST is not modified." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
473 (if (memq elt list) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
474 (delq elt (copy-sequence list)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
475 list)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
476 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
477 ;;;; Keymap support. |
114 | 478 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
479 (defmacro kbd (keys) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
480 "Convert KEYS to the internal Emacs key representation. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
481 KEYS should be a string constant in the format used for |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
482 saving keyboard macros (see `edmacro-mode')." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
483 (read-kbd-macro keys)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
484 |
114 | 485 (defun undefined () |
486 (interactive) | |
487 (ding)) | |
488 | |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
489 ;; Prevent the \{...} documentation construct |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
490 ;; from mentioning keys that run this command. |
114 | 491 (put 'undefined 'suppress-keymap t) |
492 | |
493 (defun suppress-keymap (map &optional nodigits) | |
494 "Make MAP override all normally self-inserting keys to be undefined. | |
495 Normally, as an exception, digits and minus-sign are set to make prefix args, | |
496 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
|
497 (define-key map [remap self-insert-command] 'undefined) |
114 | 498 (or nodigits |
499 (let (loop) | |
500 (define-key map "-" 'negative-argument) | |
501 ;; Make plain numbers do numeric args. | |
502 (setq loop ?0) | |
503 (while (<= loop ?9) | |
504 (define-key map (char-to-string loop) 'digit-argument) | |
505 (setq loop (1+ loop)))))) | |
506 | |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
507 (defun define-key-after (keymap key definition &optional after) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
508 "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
509 This is like `define-key' except that the binding for KEY is placed |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
510 just after the binding for the event AFTER, instead of at the beginning |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
511 of the map. Note that AFTER must be an event type (like KEY), NOT a command |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
512 \(like DEFINITION). |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
513 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
514 If AFTER is t or omitted, the new binding goes at the end of the keymap. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
515 AFTER should be a single event type--a symbol or a character, not a sequence. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
516 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
517 Bindings are always added before any inherited map. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
518 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
519 The order of bindings in a keymap matters when it is used as a menu." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
520 (unless after (setq after t)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
521 (or (keymapp keymap) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
522 (signal 'wrong-type-argument (list 'keymapp keymap))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
523 (setq key |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
524 (if (<= (length key) 1) (aref key 0) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
525 (setq keymap (lookup-key keymap |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
526 (apply 'vector |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
527 (butlast (mapcar 'identity key))))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
528 (aref key (1- (length key))))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
529 (let ((tail keymap) done inserted) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
530 (while (and (not done) tail) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
531 ;; Delete any earlier bindings for the same key. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
532 (if (eq (car-safe (car (cdr tail))) key) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
533 (setcdr tail (cdr (cdr tail)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
534 ;; If we hit an included map, go down that one. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
535 (if (keymapp (car tail)) (setq tail (car tail))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
536 ;; When we reach AFTER's binding, insert the new binding after. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
537 ;; If we reach an inherited keymap, insert just before that. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
538 ;; If we reach the end of this keymap, insert at the end. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
539 (if (or (and (eq (car-safe (car tail)) after) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
540 (not (eq after t))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
541 (eq (car (cdr tail)) 'keymap) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
542 (null (cdr tail))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
543 (progn |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
544 ;; Stop the scan only if we find a parent keymap. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
545 ;; Keep going past the inserted element |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
546 ;; so we can delete any duplications that come later. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
547 (if (eq (car (cdr tail)) 'keymap) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
548 (setq done t)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
549 ;; Don't insert more than once. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
550 (or inserted |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
551 (setcdr tail (cons (cons key definition) (cdr tail)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
552 (setq inserted t))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
553 (setq tail (cdr tail))))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
554 |
93204
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
555 (defun map-keymap-sorted (function keymap) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
556 "Implement `map-keymap' with sorting. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
557 Don't call this function; it is for internal use only." |
93204
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
558 (let (list) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
559 (map-keymap (lambda (a b) (push (cons a b) list)) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
560 keymap) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
561 (setq list (sort list |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
562 (lambda (a b) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
563 (setq a (car a) b (car b)) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
564 (if (integerp a) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
565 (if (integerp b) (< a b) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
566 t) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
567 (if (integerp b) t |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
568 ;; string< also accepts symbols. |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
569 (string< a b)))))) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
570 (dolist (p list) |
9f83f0ec5257
* subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93200
diff
changeset
|
571 (funcall function (car p) (cdr p))))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
572 |
93664
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
573 (defun keymap-canonicalize (map) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
574 "Return an equivalent keymap, without inheritance." |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
575 (let ((bindings ()) |
100699
ad20c1d5df89
(keymap-canonicalize): Properly preserve keymap prompt.
Andreas Schwab <schwab@suse.de>
parents:
100676
diff
changeset
|
576 (ranges ()) |
ad20c1d5df89
(keymap-canonicalize): Properly preserve keymap prompt.
Andreas Schwab <schwab@suse.de>
parents:
100676
diff
changeset
|
577 (prompt (keymap-prompt map))) |
93664
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
578 (while (keymapp map) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
579 (setq map (map-keymap-internal |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
580 (lambda (key item) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
581 (if (consp key) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
582 ;; Treat char-ranges specially. |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
583 (push (cons key item) ranges) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
584 (push (cons key item) bindings))) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
585 map))) |
100699
ad20c1d5df89
(keymap-canonicalize): Properly preserve keymap prompt.
Andreas Schwab <schwab@suse.de>
parents:
100676
diff
changeset
|
586 (setq map (funcall (if ranges 'make-keymap 'make-sparse-keymap) prompt)) |
93664
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
587 (dolist (binding ranges) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
588 ;; Treat char-ranges specially. |
93721
6604d09cf521
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93664
diff
changeset
|
589 (define-key map (vector (car binding)) (cdr binding))) |
93664
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
590 (dolist (binding (prog1 bindings (setq bindings ()))) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
591 (let* ((key (car binding)) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
592 (item (cdr binding)) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
593 (oldbind (assq key bindings))) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
594 ;; Newer bindings override older. |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
595 (if oldbind (setq bindings (delq oldbind bindings))) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
596 (when item ;nil bindings just hide older ones. |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
597 (push binding bindings)))) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
598 (nconc map bindings))) |
c7dd307b0ec5
* subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93396
diff
changeset
|
599 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
600 (put 'keyboard-translate-table 'char-table-extra-slots 0) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
601 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
602 (defun keyboard-translate (from to) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
603 "Translate character FROM to TO at a low level. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
604 This function creates a `keyboard-translate-table' if necessary |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
605 and then modifies one entry in it." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
606 (or (char-table-p keyboard-translate-table) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
607 (setq keyboard-translate-table |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
608 (make-char-table 'keyboard-translate-table nil))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
609 (aset keyboard-translate-table from to)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
610 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
611 ;;;; Key binding commands. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
612 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
613 (defun global-set-key (key command) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
614 "Give KEY a global binding as COMMAND. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
615 COMMAND is the command definition to use; usually it is |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
616 a symbol naming an interactively-callable function. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
617 KEY is a key sequence; noninteractively, it is a string or vector |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
618 of characters or event types, and non-ASCII characters with codes |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
619 above 127 (such as ISO Latin-1) can be included if you use a vector. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
620 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
621 Note that if KEY has a local binding in the current buffer, |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
622 that local binding will continue to shadow any global binding |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
623 that you make with this function." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
624 (interactive "KSet key globally: \nCSet key %s to command: ") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
625 (or (vectorp key) (stringp key) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
626 (signal 'wrong-type-argument (list 'arrayp key))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
627 (define-key (current-global-map) key command)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
628 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
629 (defun local-set-key (key command) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
630 "Give KEY a local binding as COMMAND. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
631 COMMAND is the command definition to use; usually it is |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
632 a symbol naming an interactively-callable function. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
633 KEY is a key sequence; noninteractively, it is a string or vector |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
634 of characters or event types, and non-ASCII characters with codes |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
635 above 127 (such as ISO Latin-1) can be included if you use a vector. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
636 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
637 The binding goes in the current buffer's local map, |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
638 which in most cases is shared with all other buffers in the same major mode." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
639 (interactive "KSet key locally: \nCSet key %s locally to command: ") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
640 (let ((map (current-local-map))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
641 (or map |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
642 (use-local-map (setq map (make-sparse-keymap)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
643 (or (vectorp key) (stringp key) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
644 (signal 'wrong-type-argument (list 'arrayp key))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
645 (define-key map key command))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
646 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
647 (defun global-unset-key (key) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
648 "Remove global binding of KEY. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
649 KEY is a string or vector representing a sequence of keystrokes." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
650 (interactive "kUnset key globally: ") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
651 (global-set-key key nil)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
652 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
653 (defun local-unset-key (key) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
654 "Remove local binding of KEY. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
655 KEY is a string or vector representing a sequence of keystrokes." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
656 (interactive "kUnset key locally: ") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
657 (if (current-local-map) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
658 (local-set-key key nil)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
659 nil) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
660 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
661 ;;;; substitute-key-definition and its subroutines. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
662 |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
663 (defvar key-substitution-in-progress nil |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
664 "Used internally by `substitute-key-definition'.") |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
665 |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
666 (defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix) |
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
667 "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF. |
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
668 In other words, OLDDEF is replaced with NEWDEF where ever it appears. |
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
669 Alternatively, if optional fourth argument OLDMAP is specified, we redefine |
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
670 in KEYMAP as NEWDEF those keys which are defined as OLDDEF in OLDMAP. |
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
671 |
68830
a924d28d2d25
(substitute-key-definition): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
68777
diff
changeset
|
672 If you don't specify OLDMAP, you can usually get the same results |
a924d28d2d25
(substitute-key-definition): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
68777
diff
changeset
|
673 in a cleaner way with command remapping, like this: |
68848
f038d760daf1
(substitute-key-definition): Doc fix (hide internal argument).
Juanma Barranquero <lekktu@gmail.com>
parents:
68830
diff
changeset
|
674 \(define-key KEYMAP [remap OLDDEF] NEWDEF) |
f038d760daf1
(substitute-key-definition): Doc fix (hide internal argument).
Juanma Barranquero <lekktu@gmail.com>
parents:
68830
diff
changeset
|
675 \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)" |
28868
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
676 ;; 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
|
677 ;; 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
|
678 ;; meaning |
47916 | 679 |
28868
e62636f5d724
(substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents:
28863
diff
changeset
|
680 ;; 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
|
681 ;; 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
|
682 ;; original key, with PREFIX added at the front. |
1176 | 683 (or prefix (setq prefix "")) |
684 (let* ((scan (or oldmap keymap)) | |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
685 (prefix1 (vconcat prefix [nil])) |
6167
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
686 (key-substitution-in-progress |
1ad8f8ccdc2b
(substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents:
6039
diff
changeset
|
687 (cons scan key-substitution-in-progress))) |
1176 | 688 ;; Scan OLDMAP, finding each char or event-symbol that |
689 ;; 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
|
690 (map-keymap |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
691 (lambda (char defn) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
692 (aset prefix1 (length prefix) char) |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
693 (substitute-key-definition-key defn olddef newdef prefix1 keymap)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
694 scan))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
695 |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
696 (defun substitute-key-definition-key (defn olddef newdef prefix keymap) |
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
697 (let (inner-def skipped menu-item) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
698 ;; 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
|
699 (if (eq (car-safe defn) 'menu-item) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
700 (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
|
701 ;; Skip past menu-prompt. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
702 (while (stringp (car-safe defn)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
703 (push (pop defn) skipped)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
704 ;; 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
|
705 (if (consp (car-safe defn)) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
706 (setq defn (cdr defn)))) |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
707 (if (or (eq defn olddef) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
708 ;; 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
|
709 ;; 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
|
710 (and (or (stringp defn) (vectorp defn)) |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
711 (equal defn olddef))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
712 (define-key keymap prefix |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
713 (if menu-item |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
714 (let ((copy (copy-sequence menu-item))) |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
715 (setcar (nthcdr 2 copy) newdef) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
716 copy) |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
717 (nconc (nreverse skipped) newdef))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
718 ;; 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
|
719 (setq inner-def |
68759
0b4b98e12e73
(substitute-key-definition-key): Pass t for NOERROR to
Kim F. Storm <storm@cua.dk>
parents:
68651
diff
changeset
|
720 (or (indirect-function defn t) defn)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
721 ;; 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
|
722 ;; 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
|
723 ;; 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
|
724 (if (and (keymapp inner-def) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
725 ;; Avoid recursively scanning |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
726 ;; where KEYMAP does not have a submap. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
727 (let ((elt (lookup-key keymap prefix))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
728 (or (null elt) (natnump elt) (keymapp elt))) |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
729 ;; Avoid recursively rescanning keymap being scanned. |
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
730 (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
|
731 ;; If this one isn't being scanned already, scan it now. |
61967
d9764486d42f
(dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents:
61955
diff
changeset
|
732 (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
|
733 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
734 |
47916 | 735 ;;;; The global keymap tree. |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
736 |
105060
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
737 ;; global-map, esc-map, and ctl-x-map have their values set up in |
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
738 ;; keymap.c; we just give them docstrings here. |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
739 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
740 (defvar global-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
741 "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
|
742 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
|
743 global map.") |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
744 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
745 (defvar esc-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
746 "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
|
747 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
|
748 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
749 (defvar ctl-x-map nil |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
750 "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
|
751 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
|
752 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
753 (defvar ctl-x-4-map (make-sparse-keymap) |
41955 | 754 "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
|
755 (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
|
756 (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
|
757 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
758 (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
|
759 "Keymap for frame commands.") |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
760 (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
|
761 (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
|
762 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
763 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
764 ;;;; Event manipulation functions. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
765 |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
766 (defconst listify-key-sequence-1 (logior 128 ?\M-\C-@)) |
3153
4c94c9faf1af
(listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents:
2963
diff
changeset
|
767 |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
768 (defun listify-key-sequence (key) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
769 "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
|
770 (if (vectorp key) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
771 (append key nil) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
772 (mapcar (function (lambda (c) |
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
773 (if (> c 127) |
3153
4c94c9faf1af
(listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents:
2963
diff
changeset
|
774 (logxor c listify-key-sequence-1) |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
775 c))) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
776 key))) |
2021
8b9286bffef8
(listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents:
1959
diff
changeset
|
777 |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
778 (defsubst eventp (obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
779 "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
|
780 (or (and (integerp obj) |
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
781 ;; 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
|
782 ;; M is the biggest modifier. |
30d4272bcc4b
(eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
55502
diff
changeset
|
783 (zerop (logand obj (lognot (1- (lsh ?\M-\^@ 1))))) |
89943
4c90ffeb71c5
Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-15
Miles Bader <miles@gnu.org>
diff
changeset
|
784 (characterp (event-basic-type obj))) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
785 (and (symbolp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
786 (get obj 'event-symbol-elements)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
787 (and (consp obj) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
788 (symbolp (car obj)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
789 (get (car obj) 'event-symbol-elements)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
790 |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
791 (defun event-modifiers (event) |
56537
69db3634588e
(butlast, event-modifiers, event-basic-type): Doc fixes.
John Paul Wallington <jpw@pobox.com>
parents:
56402
diff
changeset
|
792 "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
|
793 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
|
794 `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
|
795 and `down'. |
059dc717baef
(event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
56565
diff
changeset
|
796 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
|
797 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
|
798 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
|
799 even when EVENT actually has modifiers." |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
800 (let ((type event)) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
801 (if (listp type) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
802 (setq type (car type))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
803 (if (symbolp type) |
86099
48dc79c663f4
* subr.el (event-modifiers): Use internal-event-symbol-parse-modifiers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
86017
diff
changeset
|
804 ;; Don't read event-symbol-elements directly since we're not |
48dc79c663f4
* subr.el (event-modifiers): Use internal-event-symbol-parse-modifiers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
86017
diff
changeset
|
805 ;; sure the symbol has already been parsed. |
48dc79c663f4
* subr.el (event-modifiers): Use internal-event-symbol-parse-modifiers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
86017
diff
changeset
|
806 (cdr (internal-event-symbol-parse-modifiers type)) |
55013
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
807 (let ((list nil) |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
808 (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
|
809 ?\H-\^@ ?\s-\^@ ?\A-\^@))))) |
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
810 (if (not (zerop (logand type ?\M-\^@))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
811 (push 'meta list)) |
55013
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
812 (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
|
813 (< char 32)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
814 (push 'control list)) |
55013
aba8cece2157
(event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents:
55008
diff
changeset
|
815 (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
|
816 (/= char (downcase char))) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
817 (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
|
818 (or (zerop (logand type ?\H-\^@)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
819 (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
|
820 (or (zerop (logand type ?\s-\^@)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
821 (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
|
822 (or (zerop (logand type ?\A-\^@)) |
57480
db7d00351c33
(substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57438
diff
changeset
|
823 (push 'alt list)) |
2040
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
824 list)))) |
aa926beb4caa
(event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2033
diff
changeset
|
825 |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
826 (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
|
827 "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
|
828 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
|
829 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
|
830 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
|
831 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
|
832 (if (consp event) |
d2df5ca46b39
* subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents:
3591
diff
changeset
|
833 (setq event (car event))) |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
834 (if (symbolp event) |
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
835 (car (get event 'event-symbol-elements)) |
62524
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
836 (let* ((base (logand event (1- ?\A-\^@))) |
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
837 (uncontrolled (if (< base 32) (logior base 64) base))) |
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
838 ;; There are some numbers that are invalid characters and |
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
839 ;; cause `downcase' to get an error. |
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
840 (condition-case () |
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
841 (downcase uncontrolled) |
b54077faa74a
(event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents:
62501
diff
changeset
|
842 (error uncontrolled))))) |
2063
2f0555b428c4
(event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents:
2040
diff
changeset
|
843 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
844 (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
|
845 "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
|
846 (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
|
847 |
94556
8d02ae7cb729
* vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents:
94331
diff
changeset
|
848 (defun mouse-event-p (object) |
8d02ae7cb729
* vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents:
94331
diff
changeset
|
849 "Return non-nil if OBJECT is a mouse click event." |
8d02ae7cb729
* vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents:
94331
diff
changeset
|
850 ;; is this really correct? maybe remove mouse-movement? |
8d02ae7cb729
* vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents:
94331
diff
changeset
|
851 (memq (event-basic-type object) '(mouse-1 mouse-2 mouse-3 mouse-movement))) |
8d02ae7cb729
* vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents:
94331
diff
changeset
|
852 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
853 (defsubst event-start (event) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
854 "Return the starting position of EVENT. |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
855 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
|
856 of the event. |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
857 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
|
858 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
|
859 (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
|
860 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
|
861 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
|
862 (if (consp event) (nth 1 event) |
a8fbafaa31ad
(event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
45823
diff
changeset
|
863 (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
|
864 |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
865 (defsubst event-end (event) |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
866 "Return the ending location of EVENT. |
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
867 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
|
868 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
|
869 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
|
870 (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
|
871 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
|
872 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
|
873 (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
|
874 (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
|
875 |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
876 (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
|
877 "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
|
878 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
|
879 (if (and (consp event) (integerp (nth 2 event))) (nth 2 event) 1)) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
880 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
881 ;;;; Extracting fields of the positions in an event. |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
882 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
883 (defsubst posn-window (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
884 "Return the window in POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
885 POSITION should be a list of the form returned by the `event-start' |
53593 | 886 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
|
887 (nth 0 position)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
888 |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
889 (defsubst posn-area (position) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
890 "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
|
891 POSITION should be a list of the form returned by the `event-start' |
53593 | 892 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
893 (let ((area (if (consp (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
894 (car (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
895 (nth 1 position)))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
896 (and (symbolp area) area))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
897 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
898 (defsubst posn-point (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
899 "Return the buffer location in POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
900 POSITION should be a list of the form returned by the `event-start' |
53593 | 901 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
902 (or (nth 5 position) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
903 (if (consp (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
904 (car (nth 1 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
905 (nth 1 position)))) |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
906 |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
907 (defun posn-set-point (position) |
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
908 "Move point to POSITION. |
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
909 Select the corresponding window as well." |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
910 (if (not (windowp (posn-window position))) |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
911 (error "Position not in text area of window")) |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
912 (select-window (posn-window position)) |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
913 (if (numberp (posn-point position)) |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
914 (goto-char (posn-point position)))) |
54866
47cdc4f7ee17
(posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54626
diff
changeset
|
915 |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
916 (defsubst posn-x-y (position) |
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
917 "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
|
918 POSITION should be a list of the form returned by the `event-start' |
53593 | 919 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
|
920 (nth 2 position)) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
921 |
95841
b4e36ff621b3
Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents:
95778
diff
changeset
|
922 (declare-function scroll-bar-scale "scroll-bar" (num-denom whole)) |
b4e36ff621b3
Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents:
95778
diff
changeset
|
923 |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
924 (defun posn-col-row (position) |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
925 "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
|
926 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
|
927 and y coordinates in POSITION and the frame's default character width |
53593 | 928 and height. |
7636
83dba60657ef
(posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents:
7615
diff
changeset
|
929 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
|
930 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
|
931 POSITION should be a list of the form returned by the `event-start' |
53593 | 932 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
933 (let* ((pair (posn-x-y position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
934 (window (posn-window position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
935 (area (posn-area position))) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
936 (cond |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
937 ((null window) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
938 '(0 . 0)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
939 ((eq area 'vertical-scroll-bar) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
940 (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
|
941 ((eq area 'horizontal-scroll-bar) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
942 (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
|
943 (t |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
944 (let* ((frame (if (framep window) window (window-frame window))) |
102983
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
945 ;; FIXME: This should take line-spacing properties on |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
946 ;; newlines into account. |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
947 (spacing (when (display-graphic-p frame) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
948 (or (with-current-buffer (window-buffer window) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
949 line-spacing) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
950 (frame-parameter frame 'line-spacing))))) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
951 (cond ((floatp spacing) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
952 (setq spacing (truncate (* spacing |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
953 (frame-char-height frame))))) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
954 ((null spacing) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
955 (setq spacing 0))) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
956 (cons (/ (car pair) (frame-char-width frame)) |
945567648555
* subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents:
102658
diff
changeset
|
957 (/ (cdr pair) (+ (frame-char-height frame) spacing)))))))) |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
958 |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
959 (defun posn-actual-col-row (position) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
960 "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
|
961 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
|
962 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
|
963 `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
|
964 POSITION should be a list of the form returned by the `event-start' |
53593 | 965 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
966 (nth 6 position)) |
6039
4eb7f4633370
(posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents:
6005
diff
changeset
|
967 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
968 (defsubst posn-timestamp (position) |
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
969 "Return the timestamp of POSITION. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
970 POSITION should be a list of the form returned by the `event-start' |
53593 | 971 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
|
972 (nth 3 position)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
973 |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
974 (defsubst posn-string (position) |
70229
b85aa1663ba3
(posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
69978
diff
changeset
|
975 "Return the string object of POSITION. |
b85aa1663ba3
(posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
69978
diff
changeset
|
976 Value is a cons (STRING . STRING-POS), or nil if not a string. |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
977 POSITION should be a list of the form returned by the `event-start' |
53593 | 978 and `event-end' functions." |
53132
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
979 (nth 4 position)) |
20c6299bd4df
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53063
diff
changeset
|
980 |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
981 (defsubst posn-image (position) |
70229
b85aa1663ba3
(posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
69978
diff
changeset
|
982 "Return the image object of POSITION. |
74085
7e5dd39ae47d
(posn-image): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
73943
diff
changeset
|
983 Value is a list (image ...), or nil if not an image. |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
984 POSITION should be a list of the form returned by the `event-start' |
53593 | 985 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
986 (nth 7 position)) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
987 |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
988 (defsubst posn-object (position) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
989 "Return the object (image or string) of POSITION. |
70229
b85aa1663ba3
(posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
69978
diff
changeset
|
990 Value is a list (image ...) for an image object, a cons cell |
b85aa1663ba3
(posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
69978
diff
changeset
|
991 \(STRING . STRING-POS) for a string object, and nil for a buffer position. |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
992 POSITION should be a list of the form returned by the `event-start' |
53593 | 993 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
994 (or (posn-image position) (posn-string position))) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
995 |
53181
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
996 (defsubst posn-object-x-y (position) |
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
997 "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
|
998 POSITION should be a list of the form returned by the `event-start' |
53593 | 999 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
1000 (nth 8 position)) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
1001 |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
1002 (defsubst posn-object-width-height (position) |
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
1003 "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
|
1004 POSITION should be a list of the form returned by the `event-start' |
53593 | 1005 and `event-end' functions." |
53518
21599196e26a
(event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
53485
diff
changeset
|
1006 (nth 9 position)) |
53181
8337e648c2b3
(posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents:
53174
diff
changeset
|
1007 |
2071
8f410f56d98f
(posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents:
2063
diff
changeset
|
1008 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1009 ;;;; Obsolescent names for functions. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1010 |
105364
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1011 (define-obsolete-function-alias 'window-dot 'window-point "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1012 (define-obsolete-function-alias 'set-window-dot 'set-window-point "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1013 (define-obsolete-function-alias 'read-input 'read-string "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1014 (define-obsolete-function-alias 'show-buffer 'set-window-buffer "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1015 (define-obsolete-function-alias 'eval-current-buffer 'eval-buffer "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1016 (define-obsolete-function-alias 'string-to-int 'string-to-number "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1017 |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1018 (make-obsolete 'char-bytes "now always returns 1." "20.4") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1019 (make-obsolete 'forward-point "use (+ (point) N) instead." "23.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1020 |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1021 (defun insert-string (&rest args) |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1022 "Mocklisp-compatibility insert function. |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1023 Like the function `insert' except that any argument that is a number |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1024 is converted into a string by expressing it in decimal." |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1025 (dolist (el args) |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1026 (insert (if (integerp el) (number-to-string el) el)))) |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1027 (make-obsolete 'insert-string 'insert "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1028 |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1029 (defun makehash (&optional test) (make-hash-table :test (or test 'eql))) |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1030 (make-obsolete 'makehash 'make-hash-table "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1031 |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1032 ;; These are used by VM and some old programs |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1033 (defalias 'focus-frame 'ignore "") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1034 (make-obsolete 'focus-frame "it does nothing." "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1035 (defalias 'unfocus-frame 'ignore "") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1036 (make-obsolete 'unfocus-frame "it does nothing." "22.1") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1037 (make-obsolete 'make-variable-frame-local |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1038 "explicitly check for a frame-parameter instead." "22.2") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1039 (make-obsolete 'interactive-p 'called-interactively-p "23.2") |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1040 (set-advertised-calling-convention 'called-interactively-p '(kind)) |
105763
5041ae86859e
(all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105681
diff
changeset
|
1041 (set-advertised-calling-convention |
5041ae86859e
(all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105681
diff
changeset
|
1042 'all-completions '(string collection &optional predicate)) |
105364
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1043 |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1044 ;;;; Obsolescence declarations for variables, and aliases. |
338d102432df
* eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105317
diff
changeset
|
1045 |
104626
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1046 ;; Special "default-FOO" variables which contain the default value of |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1047 ;; the "FOO" variable are nasty. Their implementation is brittle, and |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1048 ;; slows down several unrelated variable operations; furthermore, they |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1049 ;; can lead to really odd behavior if you decide to make them |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1050 ;; buffer-local. |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1051 |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1052 ;; Not used at all in Emacs, last time I checked: |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1053 (make-obsolete-variable 'default-mode-line-format 'mode-line-format "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1054 (make-obsolete-variable 'default-header-line-format 'header-line-format "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1055 (make-obsolete-variable 'default-line-spacing 'line-spacing "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1056 (make-obsolete-variable 'default-abbrev-mode 'abbrev-mode "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1057 (make-obsolete-variable 'default-ctl-arrow 'ctl-arrow "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1058 (make-obsolete-variable 'default-truncate-lines 'truncate-lines "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1059 (make-obsolete-variable 'default-left-margin 'left-margin "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1060 (make-obsolete-variable 'default-tab-width 'tab-width "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1061 (make-obsolete-variable 'default-case-fold-search 'case-fold-search "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1062 (make-obsolete-variable 'default-left-margin-width 'left-margin-width "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1063 (make-obsolete-variable 'default-right-margin-width 'right-margin-width "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1064 (make-obsolete-variable 'default-left-fringe-width 'left-fringe-width "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1065 (make-obsolete-variable 'default-right-fringe-width 'right-fringe-width "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1066 (make-obsolete-variable 'default-fringes-outside-margins 'fringes-outside-margins "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1067 (make-obsolete-variable 'default-scroll-bar-width 'scroll-bar-width "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1068 (make-obsolete-variable 'default-vertical-scroll-bar 'vertical-scroll-bar "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1069 (make-obsolete-variable 'default-indicate-empty-lines 'indicate-empty-lines "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1070 (make-obsolete-variable 'default-indicate-buffer-boundaries 'indicate-buffer-boundaries "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1071 (make-obsolete-variable 'default-fringe-indicator-alist 'fringe-indicator-alist "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1072 (make-obsolete-variable 'default-fringe-cursor-alist 'fringe-cursor-alist "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1073 (make-obsolete-variable 'default-scroll-up-aggressively 'scroll-up-aggressively "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1074 (make-obsolete-variable 'default-scroll-down-aggressively 'scroll-down-aggressively "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1075 (make-obsolete-variable 'default-fill-column 'fill-column "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1076 (make-obsolete-variable 'default-cursor-type 'cursor-type "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1077 (make-obsolete-variable 'default-buffer-file-type 'buffer-file-type "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1078 (make-obsolete-variable 'default-cursor-in-non-selected-windows 'cursor-in-non-selected-windows "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1079 (make-obsolete-variable 'default-buffer-file-coding-system 'buffer-file-coding-system "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1080 (make-obsolete-variable 'default-major-mode 'major-mode "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1081 (make-obsolete-variable 'default-enable-multibyte-characters |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1082 "use enable-multibyte-characters or set-buffer-multibyte instead" "23.2") |
caa79498564a
* subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104368
diff
changeset
|
1083 |
104920
566d2dc55a9d
* keyboard.c (Qmenu_alias, Vdefine_key_rebound_commands): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104880
diff
changeset
|
1084 (make-obsolete-variable 'define-key-rebound-commands nil "23.2") |
93200
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1085 (make-obsolete-variable 'redisplay-end-trigger-functions 'jit-lock-register "23.1") |
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1086 (make-obsolete 'window-redisplay-end-trigger nil "23.1") |
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1087 (make-obsolete 'set-window-redisplay-end-trigger nil "23.1") |
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1088 |
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1089 (make-obsolete 'process-filter-multibyte-p nil "23.1") |
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1090 (make-obsolete 'set-process-filter-multibyte nil "23.1") |
c264aa814b15
(redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
92948
diff
changeset
|
1091 |
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
1092 (make-obsolete-variable 'directory-sep-char "do not use it." "21.1") |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1093 (make-obsolete-variable |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1094 'mode-line-inverse-video |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1095 "use the appropriate faces instead." |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1096 "21.1") |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1097 (make-obsolete-variable |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1098 'unread-command-char |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1099 "use `unread-command-events' instead. That variable is a list of events |
74597
ee63ac76eb51
(unread-command-char): Reflow obsolescence info.
Juanma Barranquero <lekktu@gmail.com>
parents:
74242
diff
changeset
|
1100 to reread, so it now uses nil to mean `no event', instead of -1." |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1101 "before 19.15") |
46537
46f175ecf5d4
(unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents:
46532
diff
changeset
|
1102 |
62015
e208ebaf0e17
(executing-macro): Use `define-obsolete-variable-alias'.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61996
diff
changeset
|
1103 ;; Lisp manual only updated in 22.1. |
e208ebaf0e17
(executing-macro): Use `define-obsolete-variable-alias'.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61996
diff
changeset
|
1104 (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1105 "before 19.34") |
62015
e208ebaf0e17
(executing-macro): Use `define-obsolete-variable-alias'.
Luc Teirlinck <teirllm@auburn.edu>
parents:
61996
diff
changeset
|
1106 |
57778
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57689
diff
changeset
|
1107 (defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1108 (make-obsolete-variable 'x-lost-selection-hooks |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1109 'x-lost-selection-functions "22.1") |
57778
82ed9ce364a7
(x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57689
diff
changeset
|
1110 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1111 (make-obsolete-variable 'x-sent-selection-hooks |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1112 'x-sent-selection-functions "22.1") |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1113 |
102032
5ff1f67594ee
(translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents:
102010
diff
changeset
|
1114 ;; This was introduced in 21.4 for pre-unicode unification. That |
5ff1f67594ee
(translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents:
102010
diff
changeset
|
1115 ;; usage was rendered obsolete in 23.1 which uses Unicode internally. |
5ff1f67594ee
(translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents:
102010
diff
changeset
|
1116 ;; Other uses are possible, so this variable is not _really_ obsolete, |
5ff1f67594ee
(translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents:
102010
diff
changeset
|
1117 ;; but Stefan insists to mark it so. |
5ff1f67594ee
(translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents:
102010
diff
changeset
|
1118 (make-obsolete-variable 'translation-table-for-input nil "23.1") |
5ff1f67594ee
(translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents:
102010
diff
changeset
|
1119 |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1120 (defvaralias 'messages-buffer-max-lines 'message-log-max) |
100997
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1121 |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1122 ;; These aliases exist in Emacs 19.34, and probably before, but were |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1123 ;; only marked as obsolete in 23.1. |
101082 | 1124 ;; The lisp manual (since at least Emacs 21) describes them as |
100997
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1125 ;; existing "for compatibility with Emacs version 18". |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1126 (define-obsolete-variable-alias 'last-input-char 'last-input-event |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1127 "at least 19.34") |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1128 (define-obsolete-variable-alias 'last-command-char 'last-command-event |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1129 "at least 19.34") |
0e99f90c4347
(last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents:
100908
diff
changeset
|
1130 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1131 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1132 ;;;; 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
|
1133 |
62542
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents:
62524
diff
changeset
|
1134 (defalias 'send-string 'process-send-string) |
3f80c5cf6771
(send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents:
62524
diff
changeset
|
1135 (defalias 'send-region 'process-send-region) |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1136 (defalias 'string= 'string-equal) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1137 (defalias 'string< 'string-lessp) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1138 (defalias 'move-marker 'set-marker) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1139 (defalias 'rplaca 'setcar) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1140 (defalias 'rplacd 'setcdr) |
3591
507f64624555
Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents:
3411
diff
changeset
|
1141 (defalias 'beep 'ding) ;preserve lingual purity |
2569
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1142 (defalias 'indent-to-column 'indent-to) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1143 (defalias 'backward-delete-char 'delete-backward-char) |
39ad4eda7fea
All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
2504
diff
changeset
|
1144 (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
|
1145 (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
|
1146 (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
|
1147 (defalias 'store-match-data 'set-match-data) |
100676
5478b71d59c6
* subr.el (chmod): New defalias for set-file-modes.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
100388
diff
changeset
|
1148 (defalias 'chmod 'set-file-modes) |
100751
2935e76b69a8
(mkdir): New defalias.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
100699
diff
changeset
|
1149 (defalias 'mkdir 'make-directory) |
31563
96b9757bfd45
(add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents:
30515
diff
changeset
|
1150 ;; These are the XEmacs names: |
25293
fd43e1a99384
(point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents:
25140
diff
changeset
|
1151 (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
|
1152 (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
|
1153 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1154 (defalias 'user-original-login-name 'user-login-name) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1155 |
114 | 1156 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1157 ;;;; Hook manipulation functions. |
388 | 1158 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1159 (defun make-local-hook (hook) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1160 "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
|
1161 The return value is HOOK. |
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
1162 |
33707
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
1163 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
|
1164 if its LOCAL argument is non-nil. |
2b9847c18f31
(make-local-hook): Docstring fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
32355
diff
changeset
|
1165 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1166 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
|
1167 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
|
1168 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
|
1169 of the hook variable. |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1170 |
39557
fb85410efef7
(define-key-after): Allow `key' to be longer than 1.
Gerd Moellmann <gerd@gnu.org>
parents:
38760
diff
changeset
|
1171 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
|
1172 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
|
1173 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
|
1174 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
|
1175 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
|
1176 one. |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
1177 |
95ebca0a74d8
(make-local-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
12108
diff
changeset
|
1178 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
|
1179 buffer. |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1180 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1181 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
|
1182 (if (local-variable-p hook) |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1183 nil |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1184 (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
|
1185 (make-local-variable hook) |
23786
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
1186 (set hook (list t))) |
673204d56938
(make-local-hook): Return the hook variable.
Richard M. Stallman <rms@gnu.org>
parents:
23736
diff
changeset
|
1187 hook) |
46052
4d27fe417297
(char-bytes): Fix obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents:
45978
diff
changeset
|
1188 (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
|
1189 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1190 (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
|
1191 "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
|
1192 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
|
1193 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
|
1194 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
|
1195 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
|
1196 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1197 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
|
1198 the hook's buffer-local value rather than its default value. |
43435 | 1199 This makes the hook buffer-local if needed, and it makes t a member |
1200 of the buffer-local value. That acts as a flag to run the hook | |
1201 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
|
1202 |
4414
3356419b94c1
(add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents:
4235
diff
changeset
|
1203 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
|
1204 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
|
1205 function, it is changed to a list of functions." |
114 | 1206 (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
|
1207 (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
|
1208 (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
|
1209 (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
|
1210 ;; 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
|
1211 ;; and do what we used to do. |
52987
ac21698ba968
(add-hook): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
52896
diff
changeset
|
1212 (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
|
1213 (setq local t))) |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
1214 (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
|
1215 ;; 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
|
1216 (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
|
1217 (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
|
1218 ;; 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
|
1219 (unless (member function hook-value) |
105944
a465c7c7e59e
* subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105940
diff
changeset
|
1220 (when (stringp function) |
a465c7c7e59e
* subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105940
diff
changeset
|
1221 (setq function (purecopy function))) |
28863
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
1222 (setq hook-value |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
1223 (if append |
6430ce03c28a
(add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
28811
diff
changeset
|
1224 (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
|
1225 (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
|
1226 ;; Set the actual variable |
87974
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1227 (if local |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1228 (progn |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1229 ;; If HOOK isn't a permanent local, |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1230 ;; but FUNCTION wants to survive a change of modes, |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1231 ;; mark HOOK as partially permanent. |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1232 (and (symbolp function) |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1233 (get function 'permanent-local-hook) |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1234 (not (get hook 'permanent-local)) |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1235 (put hook 'permanent-local 'permanent-local-hook)) |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1236 (set hook hook-value)) |
97c3cc0a167b
(add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents:
87903
diff
changeset
|
1237 (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
|
1238 |
9195
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1239 (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
|
1240 "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
|
1241 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
|
1242 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
|
1243 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
|
1244 |
70b00615cb75
(add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents:
8959
diff
changeset
|
1245 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
|
1246 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
|
1247 (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
|
1248 (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
|
1249 ;; 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
|
1250 (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
|
1251 ;; 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
|
1252 ;; 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
|
1253 (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
|
1254 (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
|
1255 (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
|
1256 (setq local t)) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
1257 (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
|
1258 ;; 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
|
1259 (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
|
1260 (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
|
1261 (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
|
1262 ;; 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
|
1263 ;;(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
|
1264 ;; (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
|
1265 ;; (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
|
1266 ;; 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
|
1267 (if (not local) |
f992824e67f0
(add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents:
52858
diff
changeset
|
1268 (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
|
1269 (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
|
1270 (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
|
1271 (set hook hook-value)))))) |
9510
f03544494d1c
(add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents:
9202
diff
changeset
|
1272 |
72784
3f19250c6e68
(add-to-list): New argument COMPARE-FN.
Richard M. Stallman <rms@gnu.org>
parents:
72138
diff
changeset
|
1273 (defun add-to-list (list-var element &optional append compare-fn) |
63797
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1274 "Add ELEMENT to the value of LIST-VAR if it isn't there yet. |
72784
3f19250c6e68
(add-to-list): New argument COMPARE-FN.
Richard M. Stallman <rms@gnu.org>
parents:
72138
diff
changeset
|
1275 The test for presence of ELEMENT is done with `equal', |
3f19250c6e68
(add-to-list): New argument COMPARE-FN.
Richard M. Stallman <rms@gnu.org>
parents:
72138
diff
changeset
|
1276 or with COMPARE-FN if that's non-nil. |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
1277 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
|
1278 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
|
1279 ELEMENT is added at the end. |
24757
f4127409d184
(add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
24699
diff
changeset
|
1280 |
43833 | 1281 The return value is the new value of LIST-VAR. |
1282 | |
9535 | 1283 If you want to use `add-to-list' on a variable that is not defined |
1284 until a certain package is loaded, you should put the call to `add-to-list' | |
1285 into a hook function that will be run only after loading the package. | |
1286 `eval-after-load' provides one way to do this. In some cases | |
1287 other hooks, such as major mode hooks, can do the job." | |
73465
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
1288 (if (cond |
73466
c470e5e21c36
(add-to-list): Fix last change--optimize for no compare-fn.
Kim F. Storm <storm@cua.dk>
parents:
73465
diff
changeset
|
1289 ((null compare-fn) |
c470e5e21c36
(add-to-list): Fix last change--optimize for no compare-fn.
Kim F. Storm <storm@cua.dk>
parents:
73465
diff
changeset
|
1290 (member element (symbol-value list-var))) |
73465
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
1291 ((eq compare-fn 'eq) |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
1292 (memq element (symbol-value list-var))) |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
1293 ((eq compare-fn 'eql) |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
1294 (memql element (symbol-value list-var))) |
73466
c470e5e21c36
(add-to-list): Fix last change--optimize for no compare-fn.
Kim F. Storm <storm@cua.dk>
parents:
73465
diff
changeset
|
1295 (t |
73555
3f351640d09f
(add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents:
73466
diff
changeset
|
1296 (let ((lst (symbol-value list-var))) |
3f351640d09f
(add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents:
73466
diff
changeset
|
1297 (while (and lst |
3f351640d09f
(add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents:
73466
diff
changeset
|
1298 (not (funcall compare-fn element (car lst)))) |
3f351640d09f
(add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents:
73466
diff
changeset
|
1299 (setq lst (cdr lst))) |
3f351640d09f
(add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents:
73466
diff
changeset
|
1300 lst))) |
21409
3e8b7782f4f5
(add-to-list): Always return updated value of LIST-VAR.
Karl Heuer <kwzh@gnu.org>
parents:
21173
diff
changeset
|
1301 (symbol-value list-var) |
32355
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
1302 (set list-var |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
1303 (if append |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
1304 (append (symbol-value list-var) (list element)) |
6bf2ae19e286
(add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents:
32131
diff
changeset
|
1305 (cons element (symbol-value list-var)))))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1306 |
63387
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1307 |
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1308 (defun add-to-ordered-list (list-var element &optional order) |
63797
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1309 "Add ELEMENT to the value of LIST-VAR if it isn't there yet. |
63605
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1310 The test for presence of ELEMENT is done with `eq'. |
63387
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1311 |
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1312 The resulting list is reordered so that the elements are in the |
63605
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1313 order given by each element's numeric list order. Elements |
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1314 without a numeric list order are placed at the end of the list. |
63387
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1315 |
63797
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1316 If the third optional argument ORDER is a number (integer or |
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1317 float), set the element's list order to the given value. If |
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1318 ORDER is nil or omitted, do not change the numeric order of |
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1319 ELEMENT. If ORDER has any other value, remove the numeric order |
7f964f8f5c85
(add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents:
63761
diff
changeset
|
1320 of ELEMENT if it has one. |
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
parents:
63387
diff
changeset
|
1321 |
63472
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1322 The list order for each element is stored in LIST-VAR's |
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
parents:
63387
diff
changeset
|
1323 `list-order' property. |
63387
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1324 |
5b9f98f257f8
(add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents:
63381
diff
changeset
|
1325 The return value is the new value of LIST-VAR." |
63472
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1326 (let ((ordering (get list-var 'list-order))) |
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1327 (unless ordering |
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1328 (put list-var 'list-order |
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1329 (setq ordering (make-hash-table :weakness 'key :test 'eq)))) |
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
parents:
63387
diff
changeset
|
1330 (when order |
63605
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1331 (puthash element (and (numberp order) order) ordering)) |
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1332 (unless (memq element (symbol-value list-var)) |
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1333 (set list-var (cons element (symbol-value list-var)))) |
63396
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
parents:
63387
diff
changeset
|
1334 (set list-var (sort (symbol-value list-var) |
18169bc4f438
(add-to-ordered-list): Rework to use list-order property of list-var.
Kim F. Storm <storm@cua.dk>
parents:
63387
diff
changeset
|
1335 (lambda (a b) |
63472
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1336 (let ((oa (gethash a ordering)) |
a89b059224fb
(add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
63396
diff
changeset
|
1337 (ob (gethash b ordering))) |
63605
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1338 (if (and oa ob) |
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1339 (< oa ob) |
99743da5284f
(add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents:
63472
diff
changeset
|
1340 oa))))))) |
70415
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1341 |
70678
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1342 (defun add-to-history (history-var newelt &optional maxelt keep-all) |
70415
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1343 "Add NEWELT to the history list stored in the variable HISTORY-VAR. |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1344 Return the new history list. |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1345 If MAXELT is non-nil, it specifies the maximum length of the history. |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1346 Otherwise, the maximum history length is the value of the `history-length' |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1347 property on symbol HISTORY-VAR, if set, or the value of the `history-length' |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1348 variable. |
70678
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1349 Remove duplicates of NEWELT if `history-delete-duplicates' is non-nil. |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1350 If optional fourth arg KEEP-ALL is non-nil, add NEWELT to history even |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1351 if it is empty or a duplicate." |
70415
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1352 (unless maxelt |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1353 (setq maxelt (or (get history-var 'history-length) |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1354 history-length))) |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1355 (let ((history (symbol-value history-var)) |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1356 tail) |
70678
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1357 (when (and (listp history) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1358 (or keep-all |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1359 (not (stringp newelt)) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1360 (> (length newelt) 0)) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1361 (or keep-all |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1362 (not (equal (car history) newelt)))) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1363 (if history-delete-duplicates |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1364 (delete newelt history)) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1365 (setq history (cons newelt history)) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1366 (when (integerp maxelt) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1367 (if (= 0 maxelt) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1368 (setq history nil) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1369 (setq tail (nthcdr (1- maxelt) history)) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1370 (when (consp tail) |
a561e5346aa8
(add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents:
70552
diff
changeset
|
1371 (setcdr tail nil))))) |
70415
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1372 (set history-var history))) |
72f273a616c1
(add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents:
70267
diff
changeset
|
1373 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1374 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1375 ;;;; Mode hooks. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1376 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1377 (defvar delay-mode-hooks nil |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1378 "If non-nil, `run-mode-hooks' should delay running the hooks.") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1379 (defvar delayed-mode-hooks nil |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1380 "List of delayed mode hooks waiting to be run.") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1381 (make-variable-buffer-local 'delayed-mode-hooks) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1382 (put 'delay-mode-hooks 'permanent-local t) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1383 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1384 (defvar after-change-major-mode-hook nil |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1385 "Normal hook run at the very end of major mode functions.") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1386 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1387 (defun run-mode-hooks (&rest hooks) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1388 "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1389 Execution is delayed if `delay-mode-hooks' is non-nil. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1390 If `delay-mode-hooks' is nil, run `after-change-major-mode-hook' |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1391 after running the mode hooks. |
81765
7effaa2c79bd
(run-mode-hooks): Docstring improvement.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81646
diff
changeset
|
1392 Major mode functions should use this instead of `run-hooks' when running their |
7effaa2c79bd
(run-mode-hooks): Docstring improvement.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81646
diff
changeset
|
1393 FOO-mode-hook." |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1394 (if delay-mode-hooks |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1395 ;; Delaying case. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1396 (dolist (hook hooks) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1397 (push hook delayed-mode-hooks)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1398 ;; Normal case, just run the hook as before plus any delayed hooks. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1399 (setq hooks (nconc (nreverse delayed-mode-hooks) hooks)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1400 (setq delayed-mode-hooks nil) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1401 (apply 'run-hooks hooks) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1402 (run-hooks 'after-change-major-mode-hook))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1403 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1404 (defmacro delay-mode-hooks (&rest body) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1405 "Execute BODY, but delay any `run-mode-hooks'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1406 These hooks will be executed by the first following call to |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1407 `run-mode-hooks' that occurs outside any `delayed-mode-hooks' form. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1408 Only affects hooks run in the current buffer." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1409 (declare (debug t) (indent 0)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1410 `(progn |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1411 (make-local-variable 'delay-mode-hooks) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1412 (let ((delay-mode-hooks t)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1413 ,@body))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1414 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1415 ;; PUBLIC: find if the current mode derives from another. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1416 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1417 (defun derived-mode-p (&rest modes) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1418 "Non-nil if the current major mode is derived from one of MODES. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1419 Uses the `derived-mode-parent' property of the symbol to trace backwards." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1420 (let ((parent major-mode)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1421 (while (and (not (memq parent modes)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1422 (setq parent (get parent 'derived-mode-parent)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1423 parent)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1424 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1425 ;;;; Minor modes. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1426 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1427 ;; If a minor mode is not defined with define-minor-mode, |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1428 ;; add it here explicitly. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1429 ;; isearch-mode is deliberately excluded, since you should |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1430 ;; not call it yourself. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1431 (defvar minor-mode-list '(auto-save-mode auto-fill-mode abbrev-mode |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1432 overwrite-mode view-mode |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1433 hs-minor-mode) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1434 "List of all minor mode functions.") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1435 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1436 (defun add-minor-mode (toggle name &optional keymap after toggle-fun) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1437 "Register a new minor mode. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1438 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1439 This is an XEmacs-compatibility function. Use `define-minor-mode' instead. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1440 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1441 TOGGLE is a symbol which is the name of a buffer-local variable that |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1442 is toggled on or off to say whether the minor mode is active or not. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1443 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1444 NAME specifies what will appear in the mode line when the minor mode |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1445 is active. NAME should be either a string starting with a space, or a |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1446 symbol whose value is such a string. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1447 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1448 Optional KEYMAP is the keymap for the minor mode that will be added |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1449 to `minor-mode-map-alist'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1450 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1451 Optional AFTER specifies that TOGGLE should be added after AFTER |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1452 in `minor-mode-alist'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1453 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1454 Optional TOGGLE-FUN is an interactive function to toggle the mode. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1455 It defaults to (and should by convention be) TOGGLE. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1456 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1457 If TOGGLE has a non-nil `:included' property, an entry for the mode is |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1458 included in the mode-line minor mode menu. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1459 If TOGGLE has a `:menu-tag', that is used for the menu item's label." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1460 (unless (memq toggle minor-mode-list) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1461 (push toggle minor-mode-list)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1462 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1463 (unless toggle-fun (setq toggle-fun toggle)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1464 (unless (eq toggle-fun toggle) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1465 (put toggle :minor-mode-function toggle-fun)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1466 ;; Add the name to the minor-mode-alist. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1467 (when name |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1468 (let ((existing (assq toggle minor-mode-alist))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1469 (if existing |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1470 (setcdr existing (list name)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1471 (let ((tail minor-mode-alist) found) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1472 (while (and tail (not found)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1473 (if (eq after (caar tail)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1474 (setq found tail) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1475 (setq tail (cdr tail)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1476 (if found |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1477 (let ((rest (cdr found))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1478 (setcdr found nil) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1479 (nconc found (list (list toggle name)) rest)) |
108243
be3f6d650654
Minor cleanups.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108006
diff
changeset
|
1480 (push (list toggle name) minor-mode-alist)))))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1481 ;; Add the toggle to the minor-modes menu if requested. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1482 (when (get toggle :included) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1483 (define-key mode-line-mode-menu |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1484 (vector toggle) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1485 (list 'menu-item |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1486 (concat |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1487 (or (get toggle :menu-tag) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1488 (if (stringp name) name (symbol-name toggle))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1489 (let ((mode-name (if (symbolp name) (symbol-value name)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1490 (if (and (stringp mode-name) (string-match "[^ ]+" mode-name)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1491 (concat " (" (match-string 0 mode-name) ")")))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1492 toggle-fun |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1493 :button (cons :toggle toggle)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1494 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1495 ;; Add the map to the minor-mode-map-alist. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1496 (when keymap |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1497 (let ((existing (assq toggle minor-mode-map-alist))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1498 (if existing |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1499 (setcdr existing keymap) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1500 (let ((tail minor-mode-map-alist) found) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1501 (while (and tail (not found)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1502 (if (eq after (caar tail)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1503 (setq found tail) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1504 (setq tail (cdr tail)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1505 (if found |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1506 (let ((rest (cdr found))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1507 (setcdr found nil) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1508 (nconc found (list (cons toggle keymap)) rest)) |
108243
be3f6d650654
Minor cleanups.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
108006
diff
changeset
|
1509 (push (cons toggle keymap) minor-mode-map-alist))))))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1510 |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1511 ;;; Load history |
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1512 |
70267
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1513 ;; (defvar symbol-file-load-history-loaded nil |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1514 ;; "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1515 ;; That file records the part of `load-history' for preloaded files, |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1516 ;; which is cleared out before dumping to make Emacs smaller.") |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1517 |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1518 ;; (defun load-symbol-file-load-history () |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1519 ;; "Load the file `fns-VERSION.el' in `exec-directory' if not already done. |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1520 ;; That file records the part of `load-history' for preloaded files, |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1521 ;; which is cleared out before dumping to make Emacs smaller." |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1522 ;; (unless symbol-file-load-history-loaded |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1523 ;; (load (expand-file-name |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1524 ;; ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1525 ;; (if (eq system-type 'ms-dos) |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1526 ;; "fns.el" |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1527 ;; (format "fns-%s.el" emacs-version)) |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1528 ;; exec-directory) |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1529 ;; ;; The file name fns-%s.el already has a .el extension. |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1530 ;; nil nil t) |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
1531 ;; (setq symbol-file-load-history-loaded t))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1532 |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1533 (defun symbol-file (symbol &optional type) |
98026
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1534 "Return the name of the file that defined SYMBOL. |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1535 The value is normally an absolute file name. It can also be nil, |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1536 if the definition is not associated with any file. If SYMBOL |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1537 specifies an autoloaded function, the value can be a relative |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1538 file name without extension. |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1539 |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1540 If TYPE is nil, then any kind of definition is acceptable. If |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1541 TYPE is `defun', `defvar', or `defface', that specifies function |
1965167a6de7
(symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents:
97882
diff
changeset
|
1542 definition, variable definition, or face definition only." |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1543 (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
|
1544 (symbolp symbol) (fboundp symbol) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1545 (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
|
1546 (nth 1 (symbol-function symbol)) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1547 (let ((files load-history) |
48474
33dafec6a9de
(symbol-file): Remove unused variable `functions'.
John Paul Wallington <jpw@pobox.com>
parents:
48077
diff
changeset
|
1548 file) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1549 (while files |
59124
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1550 (if (if type |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1551 (if (eq type 'defvar) |
f38536b30f3a
(messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents:
58934
diff
changeset
|
1552 ;; 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
|
1553 (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
|
1554 ;; 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
|
1555 (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
|
1556 ;; 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
|
1557 ;; 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
|
1558 (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
|
1559 (rassq symbol (cdr (car files))))) |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1560 (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
|
1561 (setq files (cdr files))) |
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
1562 file))) |
39725
c64d3e3adf5d
(symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents:
39598
diff
changeset
|
1563 |
66508
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1564 (defun locate-library (library &optional nosuffix path interactive-call) |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1565 "Show the precise file name of Emacs library LIBRARY. |
102010
5a441ce3d28d
(locate-library): Doc fix. (Bug#2291)
Eli Zaretskii <eliz@gnu.org>
parents:
101852
diff
changeset
|
1566 LIBRARY should be a relative file name of the library, a string. |
5a441ce3d28d
(locate-library): Doc fix. (Bug#2291)
Eli Zaretskii <eliz@gnu.org>
parents:
101852
diff
changeset
|
1567 It can omit the suffix (a.k.a. file-name extension) if NOSUFFIX is |
5a441ce3d28d
(locate-library): Doc fix. (Bug#2291)
Eli Zaretskii <eliz@gnu.org>
parents:
101852
diff
changeset
|
1568 nil (which is the default, see below). |
66508
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1569 This command searches the directories in `load-path' like `\\[load-library]' |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1570 to find the file that `\\[load-library] RET LIBRARY RET' would load. |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1571 Optional second arg NOSUFFIX non-nil means don't add suffixes `load-suffixes' |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1572 to the specified name LIBRARY. |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1573 |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1574 If the optional third arg PATH is specified, that list of directories |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1575 is used instead of `load-path'. |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1576 |
95757 | 1577 When called from a program, the file name is normally returned as a |
66508
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1578 string. When run interactively, the argument INTERACTIVE-CALL is t, |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1579 and the file name is displayed in the echo area." |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1580 (interactive (list (completing-read "Locate library: " |
94183
bade431b9780
* finder.el (finder-commentary):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94013
diff
changeset
|
1581 (apply-partially |
bade431b9780
* finder.el (finder-commentary):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94013
diff
changeset
|
1582 'locate-file-completion-table |
bade431b9780
* finder.el (finder-commentary):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94013
diff
changeset
|
1583 load-path (get-load-suffixes))) |
66508
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1584 nil nil |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1585 t)) |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1586 (let ((file (locate-file library |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1587 (or path load-path) |
69168
6e701396a0ec
(locate-library): Use `get-load-suffixes' instead of `load-suffixes'
Luc Teirlinck <teirllm@auburn.edu>
parents:
68848
diff
changeset
|
1588 (append (unless nosuffix (get-load-suffixes)) |
6e701396a0ec
(locate-library): Use `get-load-suffixes' instead of `load-suffixes'
Luc Teirlinck <teirllm@auburn.edu>
parents:
68848
diff
changeset
|
1589 load-file-rep-suffixes)))) |
66508
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1590 (if interactive-call |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1591 (if file |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1592 (message "Library is file %s" (abbreviate-file-name file)) |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1593 (message "No library %s in search path" library))) |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1594 file)) |
ecdadc99bf8c
* subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents:
66315
diff
changeset
|
1595 |
114 | 1596 |
66306
138f9b1d6682
(eval-at-startup): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
66304
diff
changeset
|
1597 ;;;; Specifying things to do later. |
138f9b1d6682
(eval-at-startup): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
66304
diff
changeset
|
1598 |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1599 (defun load-history-regexp (file) |
71037
a0da1a83020d
(load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents:
70903
diff
changeset
|
1600 "Form a regexp to find FILE in `load-history'. |
a0da1a83020d
(load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents:
70903
diff
changeset
|
1601 FILE, a string, is described in the function `eval-after-load'." |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1602 (if (file-name-absolute-p file) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1603 (setq file (file-truename file))) |
71037
a0da1a83020d
(load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents:
70903
diff
changeset
|
1604 (concat (if (file-name-absolute-p file) "\\`" "\\(\\`\\|/\\)") |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1605 (regexp-quote file) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1606 (if (file-name-extension file) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1607 "" |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1608 ;; Note: regexp-opt can't be used here, since we need to call |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1609 ;; this before Emacs has been fully started. 2006-05-21 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1610 (concat "\\(" (mapconcat 'regexp-quote load-suffixes "\\|") "\\)?")) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1611 "\\(" (mapconcat 'regexp-quote jka-compr-load-suffixes "\\|") |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1612 "\\)?\\'")) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1613 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1614 (defun load-history-filename-element (file-regexp) |
71037
a0da1a83020d
(load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents:
70903
diff
changeset
|
1615 "Get the first elt of `load-history' whose car matches FILE-REGEXP. |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1616 Return nil if there isn't one." |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1617 (let* ((loads load-history) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1618 (load-elt (and loads (car loads)))) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1619 (save-match-data |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1620 (while (and loads |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1621 (or (null (car load-elt)) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1622 (not (string-match file-regexp (car load-elt))))) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1623 (setq loads (cdr loads) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1624 load-elt (and loads (car loads))))) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1625 load-elt)) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1626 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1627 (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
|
1628 "Arrange that, if FILE is ever loaded, FORM will be run at that time. |
10794
4443f78a2117
(eval-after-load): Run FORM now if FILE's already loaded.
Richard M. Stallman <rms@gnu.org>
parents:
10693
diff
changeset
|
1629 If FILE is already loaded, evaluate FORM right now. |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1630 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1631 If a matching file is loaded again, FORM will be evaluated again. |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1632 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1633 If FILE is a string, it may be either an absolute or a relative file |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1634 name, and may have an extension \(e.g. \".el\") or may lack one, and |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1635 additionally may or may not have an extension denoting a compressed |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1636 format \(e.g. \".gz\"). |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1637 |
71037
a0da1a83020d
(load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents:
70903
diff
changeset
|
1638 When FILE is absolute, this first converts it to a true name by chasing |
a0da1a83020d
(load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents:
70903
diff
changeset
|
1639 symbolic links. Only a file of this name \(see next paragraph regarding |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1640 extensions) will trigger the evaluation of FORM. When FILE is relative, |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1641 a file whose absolute true name ends in FILE will trigger evaluation. |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1642 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1643 When FILE lacks an extension, a file name with any extension will trigger |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1644 evaluation. Otherwise, its extension must match FILE's. A further |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1645 extension for a compressed format \(e.g. \".gz\") on FILE will not affect |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1646 this name matching. |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1647 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1648 Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM |
103731 | 1649 is evaluated whenever that feature is `provide'd. Note that although |
1650 provide statements are usually at the end of files, this is not always | |
1651 the case (e.g., sometimes they are at the start to avoid a recursive | |
1652 load error). If your FORM should not be evaluated until the code in | |
1653 FILE has been, do not use the symbol form for FILE in such cases. | |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1654 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1655 Usually FILE is just a library name like \"font-lock\" or a feature name |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1656 like 'font-lock. |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1657 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1658 This function makes or adds to an entry on `after-load-alist'." |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1659 ;; Add this FORM into after-load-alist (regardless of whether we'll be |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1660 ;; evaluating it now). |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1661 (let* ((regexp-or-feature |
105944
a465c7c7e59e
* subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105940
diff
changeset
|
1662 (if (stringp file) (setq file (purecopy (load-history-regexp file))) file)) |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1663 (elt (assoc regexp-or-feature after-load-alist))) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1664 (unless elt |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1665 (setq elt (list regexp-or-feature)) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1666 (push elt after-load-alist)) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1667 ;; Add FORM to the element unless it's already there. |
41140
dc77550aede3
(eval-after-load): Make it work with features as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40832
diff
changeset
|
1668 (unless (member form (cdr elt)) |
105944
a465c7c7e59e
* subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105940
diff
changeset
|
1669 (nconc elt (purecopy (list form)))) |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1670 |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1671 ;; Is there an already loaded file whose name (or `provide' name) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1672 ;; matches FILE? |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1673 (if (if (stringp file) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1674 (load-history-filename-element regexp-or-feature) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1675 (featurep file)) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1676 (eval form)))) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1677 |
105027
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1678 (defvar after-load-functions nil |
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1679 "Special hook run after loading a file. |
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1680 Each function there is called with a single argument, the absolute |
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1681 name of the file just loaded.") |
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1682 |
70879
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1683 (defun do-after-load-evaluation (abs-file) |
238e43ed886e
startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents:
70678
diff
changeset
|
1684 "Evaluate all `eval-after-load' forms, if any, for ABS-FILE. |
104977
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1685 ABS-FILE, a string, should be the absolute true name of a file just loaded. |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1686 This function is called directly from the C code." |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1687 ;; Run the relevant eval-after-load forms. |
104737
8224438aa3cd
* subr.el (do-after-load-evaluation): Fix last change: use `mapc'
Juanma Barranquero <lekktu@gmail.com>
parents:
104715
diff
changeset
|
1688 (mapc #'(lambda (a-l-element) |
8224438aa3cd
* subr.el (do-after-load-evaluation): Fix last change: use `mapc'
Juanma Barranquero <lekktu@gmail.com>
parents:
104715
diff
changeset
|
1689 (when (and (stringp (car a-l-element)) |
8224438aa3cd
* subr.el (do-after-load-evaluation): Fix last change: use `mapc'
Juanma Barranquero <lekktu@gmail.com>
parents:
104715
diff
changeset
|
1690 (string-match-p (car a-l-element) abs-file)) |
8224438aa3cd
* subr.el (do-after-load-evaluation): Fix last change: use `mapc'
Juanma Barranquero <lekktu@gmail.com>
parents:
104715
diff
changeset
|
1691 ;; discard the file name regexp |
8224438aa3cd
* subr.el (do-after-load-evaluation): Fix last change: use `mapc'
Juanma Barranquero <lekktu@gmail.com>
parents:
104715
diff
changeset
|
1692 (mapc #'eval (cdr a-l-element)))) |
104977
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1693 after-load-alist) |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1694 ;; Complain when the user uses obsolete files. |
105027
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1695 (when (string-match-p "/obsolete/[^/]*\\'" abs-file) |
104977
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1696 (run-with-timer 0 nil |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1697 (lambda (file) |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1698 (message "Package %s is obsolete!" |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1699 (substring file 0 |
1e1816f211ce
* lread.c (Fload): Don't output a message after loading an obsolete
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104920
diff
changeset
|
1700 (string-match "\\.elc?\\>" file)))) |
105027
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1701 (file-name-nondirectory abs-file))) |
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1702 ;; Finally, run any other hook. |
8cbad31101f6
(after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104978
diff
changeset
|
1703 (run-hook-with-args 'after-load-functions abs-file)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1704 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1705 (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
|
1706 "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
|
1707 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
|
1708 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
|
1709 (eval-after-load file (read))) |
105060
78c0a7ca3aaf
(push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105027
diff
changeset
|
1710 (make-obsolete 'eval-next-after-load `eval-after-load "23.2") |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1711 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1712 ;;;; Process stuff. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1713 |
86172
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1714 (defun process-lines (program &rest args) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1715 "Execute PROGRAM with ARGS, returning its output as a list of lines. |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1716 Signal an error if the program returns with a non-zero exit status." |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1717 (with-temp-buffer |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1718 (let ((status (apply 'call-process program nil (current-buffer) nil args))) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1719 (unless (eq status 0) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1720 (error "%s exited with status %s" program status)) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1721 (goto-char (point-min)) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1722 (let (lines) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1723 (while (not (eobp)) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1724 (setq lines (cons (buffer-substring-no-properties |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1725 (line-beginning-position) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1726 (line-end-position)) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1727 lines)) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1728 (forward-line 1)) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1729 (nreverse lines))))) |
e8cb5c919219
(process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents:
86152
diff
changeset
|
1730 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
1731 ;; open-network-stream is a wrapper around make-network-process. |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1732 |
62372
4560134d21fa
(open-network-stream-nowait): Remove.
Kim F. Storm <storm@cua.dk>
parents:
62326
diff
changeset
|
1733 (when (featurep 'make-network-process) |
4560134d21fa
(open-network-stream-nowait): Remove.
Kim F. Storm <storm@cua.dk>
parents:
62326
diff
changeset
|
1734 (defun open-network-stream (name buffer host service) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1735 "Open a TCP connection for a service to a host. |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1736 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
|
1737 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
|
1738 |
103485 | 1739 NAME is the name for the process. It is modified if necessary to make |
1740 it unique. | |
103484
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1741 BUFFER is the buffer (or buffer name) to associate with the |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1742 process. Process output goes at end of that buffer. BUFFER may |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1743 be nil, meaning that this process is not associated with any buffer. |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1744 HOST is the name or IP address of the host to connect to. |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1745 SERVICE is the name of the service desired, or an integer specifying |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1746 a port number to connect to. |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1747 |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1748 This is a wrapper around `make-network-process', and only offers a |
d0c5be11f069
(open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents:
103107
diff
changeset
|
1749 subset of its functionality." |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1750 (make-network-process :name name :buffer buffer |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1751 :host host :service service))) |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1752 |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1753 ;; compatibility |
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1754 |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1755 (make-obsolete |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1756 'process-kill-without-query |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1757 "use `process-query-on-exit-flag' or `set-process-query-on-exit-flag'." |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1758 "22.1") |
45587
02df8e2ff88b
(open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents:
45246
diff
changeset
|
1759 (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
|
1760 "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
|
1761 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
|
1762 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
|
1763 (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
|
1764 (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
|
1765 old)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1766 |
103970
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1767 (defun process-kill-buffer-query-function () |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1768 "Ask before killing a buffer that has a running process." |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1769 (let ((process (get-buffer-process (current-buffer)))) |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1770 (or (not process) |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1771 (not (memq (process-status process) '(run stop open listen))) |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1772 (not (process-query-on-exit-flag process)) |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1773 (yes-or-no-p "Buffer has a running process; kill it? ")))) |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1774 |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1775 (add-hook 'kill-buffer-query-functions 'process-kill-buffer-query-function) |
340cbf291f8a
(process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents:
103884
diff
changeset
|
1776 |
49225
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1777 ;; process plist management |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1778 |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1779 (defun process-get (process propname) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1780 "Return the value of PROCESS' PROPNAME property. |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1781 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
|
1782 (plist-get (process-plist process) propname)) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1783 |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1784 (defun process-put (process propname value) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1785 "Change PROCESS' PROPNAME property to VALUE. |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1786 It can be retrieved with `(process-get PROCESS PROPNAME)'." |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49492
diff
changeset
|
1787 (set-process-plist process |
49225
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1788 (plist-put (process-plist process) propname value))) |
50cb245b2072
(process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents:
48935
diff
changeset
|
1789 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1790 |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1791 ;;;; Input and display facilities. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1792 |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
1793 (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
|
1794 "*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
|
1795 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
|
1796 |
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
1797 (custom-declare-variable-early |
47916 | 1798 'read-quoted-char-radix 8 |
18880
1ed40ed8e0c1
(custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents:
18828
diff
changeset
|
1799 "*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
|
1800 Legitimate radix values are 8, 10 and 16." |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1801 :type '(choice (const 8) (const 10) (const 16)) |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
1802 :group 'editing-basics) |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
1803 |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1804 (defconst read-key-empty-map (make-sparse-keymap)) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1805 |
105681
fac384c9a868
(read-key-delay): Reduce to 0.01.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105631
diff
changeset
|
1806 (defvar read-key-delay 0.01) ;Fast enough for 100Hz repeat rate, hopefully. |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1807 |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1808 (defun read-key (&optional prompt) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1809 "Read a key from the keyboard. |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1810 Contrary to `read-event' this will not return a raw event but instead will |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1811 obey the input decoding and translations usually done by `read-key-sequence'. |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1812 So escape sequences and keyboard encoding are taken into account. |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1813 When there's an ambiguity because the key looks like the prefix of |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1814 some sort of escape sequence, the ambiguity is resolved via `read-key-delay'." |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1815 (let ((overriding-terminal-local-map read-key-empty-map) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1816 (overriding-local-map nil) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1817 (old-global-map (current-global-map)) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1818 (timer (run-with-idle-timer |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1819 ;; Wait long enough that Emacs has the time to receive and |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1820 ;; process all the raw events associated with the single-key. |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1821 ;; But don't wait too long, or the user may find the delay |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1822 ;; annoying (or keep hitting more keys which may then get |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1823 ;; lost or misinterpreted). |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1824 ;; This is only relevant for keys which Emacs perceives as |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1825 ;; "prefixes", such as C-x (because of the C-x 8 map in |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1826 ;; key-translate-table and the C-x @ map in function-key-map) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1827 ;; or ESC (because of terminal escape sequences in |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1828 ;; input-decode-map). |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1829 read-key-delay t |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1830 (lambda () |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1831 (let ((keys (this-command-keys-vector))) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1832 (unless (zerop (length keys)) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1833 ;; `keys' is non-empty, so the user has hit at least |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1834 ;; one key; there's no point waiting any longer, even |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1835 ;; though read-key-sequence thinks we should wait |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1836 ;; for more input to decide how to interpret the |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1837 ;; current input. |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1838 (throw 'read-key keys))))))) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1839 (unwind-protect |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1840 (progn |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1841 (use-global-map read-key-empty-map) |
105681
fac384c9a868
(read-key-delay): Reduce to 0.01.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105631
diff
changeset
|
1842 (aref (catch 'read-key (read-key-sequence-vector prompt nil t)) 0)) |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1843 (cancel-timer timer) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1844 (use-global-map old-global-map)))) |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
1845 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1846 (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
|
1847 "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
|
1848 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
|
1849 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
|
1850 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
|
1851 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
|
1852 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
|
1853 |
21008
7111f9cf9392
(read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
20939
diff
changeset
|
1854 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
|
1855 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
|
1856 for numeric input." |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1857 (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
|
1858 (while (not done) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1859 (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
|
1860 ;; 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
|
1861 (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
|
1862 (help-form |
f75e47f673f4
(read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents:
12016
diff
changeset
|
1863 "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
|
1864 or the octal character code. |
18828
4837387f683c
(read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents:
18821
diff
changeset
|
1865 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
|
1866 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
|
1867 (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
|
1868 (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
|
1869 ;; 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
|
1870 ;; 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
|
1871 ;; 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
|
1872 ;; 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
|
1873 ;; bound to some prefix in function-key-map or key-translation-map. |
92498
eb2dddded6bc
(read-quoted-char): Resolve modifers of the character event.
Kenichi Handa <handa@m17n.org>
parents:
92148
diff
changeset
|
1874 (setq translated |
eb2dddded6bc
(read-quoted-char): Resolve modifers of the character event.
Kenichi Handa <handa@m17n.org>
parents:
92148
diff
changeset
|
1875 (if (integerp char) |
98382
c05c152df43c
(read-quoted-char): Call char-resolve-modifiers
Martin Rudalics <rudalics@gmx.at>
parents:
98315
diff
changeset
|
1876 (char-resolve-modifiers char) |
92498
eb2dddded6bc
(read-quoted-char): Resolve modifers of the character event.
Kenichi Handa <handa@m17n.org>
parents:
92148
diff
changeset
|
1877 char)) |
83394
7d093d9d4479
Fix semantics of terminal-local variables. Remove `terminal-local-value' hack.
Karoly Lorentey <lorentey@elte.hu>
parents:
83392
diff
changeset
|
1878 (let ((translation (lookup-key local-function-key-map (vector char)))) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1879 (if (arrayp translation) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1880 (setq translated (aref translation 0)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1881 (cond ((null translated)) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1882 ((not (integerp translated)) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1883 (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
|
1884 done t)) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1885 ((/= (logand translated ?\M-\^@) 0) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
1886 ;; 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
|
1887 (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
|
1888 done t)) |
105763
5041ae86859e
(all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105681
diff
changeset
|
1889 ((and (<= ?0 translated) |
5041ae86859e
(all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105681
diff
changeset
|
1890 (< translated (+ ?0 (min 10 read-quoted-char-radix)))) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1891 (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
|
1892 (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
|
1893 ((and (<= ?a (downcase translated)) |
105763
5041ae86859e
(all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105681
diff
changeset
|
1894 (< (downcase translated) |
5041ae86859e
(all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105681
diff
changeset
|
1895 (+ ?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
|
1896 (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
|
1897 (+ 10 (- (downcase translated) ?a)))) |
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1898 (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
|
1899 ((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
|
1900 (setq done t)) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1901 ((not first) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1902 (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
|
1903 done t)) |
50427
6ce9db7934cb
(read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents:
50417
diff
changeset
|
1904 (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
|
1905 done t))) |
83425393d550
(read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents:
18044
diff
changeset
|
1906 (setq first nil)) |
19175
3d80c899a15d
(read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents:
19002
diff
changeset
|
1907 code)) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
1908 |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1909 (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
|
1910 "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
|
1911 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
|
1912 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
|
1913 |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1914 This function echoes `.' for each character that the user types. |
99629
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1915 |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1916 The user ends with RET, LFD, or ESC. DEL or C-h rubs out. |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1917 C-y yanks the current kill. C-u kills line. |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1918 C-g quits; if `inhibit-quit' was non-nil around this function, |
70901
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
1919 then it returns nil if the user types C-g, but quit-flag remains set. |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1920 |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1921 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
|
1922 by doing (clear-string STRING)." |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1923 (with-local-quit |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1924 (if confirm |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1925 (let (success) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1926 (while (not success) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1927 (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
|
1928 (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
|
1929 (if (equal first second) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1930 (progn |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1931 (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
|
1932 (setq success first)) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1933 (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
|
1934 (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
|
1935 (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
|
1936 (sit-for 1)))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1937 success) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1938 (let ((pass nil) |
70897
b08d75867f7f
(read-passwd): Copy PROMPT before changing its properties.
Richard M. Stallman <rms@gnu.org>
parents:
70879
diff
changeset
|
1939 ;; Copy it so that add-text-properties won't modify |
b08d75867f7f
(read-passwd): Copy PROMPT before changing its properties.
Richard M. Stallman <rms@gnu.org>
parents:
70879
diff
changeset
|
1940 ;; the object that was passed in by the caller. |
b08d75867f7f
(read-passwd): Copy PROMPT before changing its properties.
Richard M. Stallman <rms@gnu.org>
parents:
70879
diff
changeset
|
1941 (prompt (copy-sequence prompt)) |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1942 (c 0) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1943 (echo-keystrokes 0) |
69978
cb54ae454387
(read-passwd): Bind `message-log-max' to nil.
Romain Francoise <romain@orebokech.com>
parents:
69830
diff
changeset
|
1944 (cursor-in-echo-area t) |
99632
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1945 (message-log-max nil) |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1946 (stop-keys (list 'return ?\r ?\n ?\e)) |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1947 (rubout-keys (list 'backspace ?\b ?\177))) |
67012
6b634736fd83
(read-passwd): Fontify the prompt as we do with other prompts.
Eli Zaretskii <eliz@gnu.org>
parents:
66508
diff
changeset
|
1948 (add-text-properties 0 (length prompt) |
6b634736fd83
(read-passwd): Fontify the prompt as we do with other prompts.
Eli Zaretskii <eliz@gnu.org>
parents:
66508
diff
changeset
|
1949 minibuffer-prompt-properties prompt) |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1950 (while (progn (message "%s%s" |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1951 prompt |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1952 (make-string (length pass) ?.)) |
104368
f700ef41d26c
(read-passwd): Use read-key so keypad keys work as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104354
diff
changeset
|
1953 (setq c (read-key)) |
99632
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1954 (not (memq c stop-keys))) |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1955 (clear-this-command-keys) |
99632
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1956 (cond ((memq c rubout-keys) ; rubout |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1957 (when (> (length pass) 0) |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1958 (let ((new-pass (substring pass 0 -1))) |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1959 (and (arrayp pass) (clear-string pass)) |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1960 (setq pass new-pass)))) |
104368
f700ef41d26c
(read-passwd): Use read-key so keypad keys work as well.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104354
diff
changeset
|
1961 ((eq c ?\C-g) (keyboard-quit)) |
99632
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1962 ((not (numberp c))) |
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1963 ((= c ?\C-u) ; kill line |
99629
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1964 (and (arrayp pass) (clear-string pass)) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1965 (setq pass "")) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1966 ((= c ?\C-y) ; yank |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1967 (let* ((str (condition-case nil |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1968 (current-kill 0) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1969 (error nil))) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1970 new-pass) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1971 (when str |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1972 (setq new-pass |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1973 (concat pass |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1974 (substring-no-properties str))) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1975 (and (arrayp pass) (clear-string pass)) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1976 (setq c ?\0) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1977 (setq pass new-pass)))) |
99632
73ea1a22b6f4
(read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents:
99629
diff
changeset
|
1978 ((characterp c) ; insert char |
99629
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1979 (let* ((new-char (char-to-string c)) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1980 (new-pass (concat pass new-char))) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1981 (and (arrayp pass) (clear-string pass)) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1982 (clear-string new-char) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1983 (setq c ?\0) |
a1ebcf06b544
(read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents:
99365
diff
changeset
|
1984 (setq pass new-pass))))) |
57789
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1985 (message nil) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1986 (or pass default ""))))) |
6a6fe71c779d
subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents:
57778
diff
changeset
|
1987 |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1988 ;; 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
|
1989 (defun read-number (prompt &optional default) |
77359
d57bf0ca865e
(read-number): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
77092
diff
changeset
|
1990 "Read a numeric value in the minibuffer, prompting with PROMPT. |
d57bf0ca865e
(read-number): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
77092
diff
changeset
|
1991 DEFAULT specifies a default value to return if the user just types RET. |
d57bf0ca865e
(read-number): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
77092
diff
changeset
|
1992 The value of DEFAULT is inserted into PROMPT." |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1993 (let ((n nil)) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1994 (when default |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
1995 (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
|
1996 (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
|
1997 (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
|
1998 (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
|
1999 (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
|
2000 prompt t t)))) |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2001 (while |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2002 (progn |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2003 (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
|
2004 (and default |
f5cafaedbab0
(read-number): Check whether `default' is nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54887
diff
changeset
|
2005 (number-to-string default))))) |
77423
954d7a5a16f6
(read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents:
77359
diff
changeset
|
2006 (condition-case nil |
954d7a5a16f6
(read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents:
77359
diff
changeset
|
2007 (setq n (cond |
954d7a5a16f6
(read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents:
77359
diff
changeset
|
2008 ((zerop (length str)) default) |
954d7a5a16f6
(read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents:
77359
diff
changeset
|
2009 ((stringp str) (read str)))) |
954d7a5a16f6
(read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents:
77359
diff
changeset
|
2010 (error nil))) |
54570
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2011 (unless (numberp n) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2012 (message "Please enter a number.") |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2013 (sit-for 1) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2014 t))) |
cf58c77ee000
(read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
54016
diff
changeset
|
2015 n)) |
71763
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2016 |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2017 (defun sit-for (seconds &optional nodisp obsolete) |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2018 "Perform redisplay, then wait for SECONDS seconds or until input is available. |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2019 SECONDS may be a floating-point value. |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2020 \(On operating systems that do not support waiting for fractions of a |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2021 second, floating-point values are rounded down to the nearest integer.) |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2022 |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2023 If optional arg NODISP is t, don't redisplay, just wait for input. |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2024 Redisplay does not happen if input is available before it starts. |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2025 |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2026 Value is t if waited the full time with no input arriving, and nil otherwise. |
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2027 |
71775
dbb73e0b716b
(sit-for): Doc fix. Specify normal arg list using fn-form.
Kim F. Storm <storm@cua.dk>
parents:
71763
diff
changeset
|
2028 An obsolete, but still supported form is |
71763
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2029 \(sit-for SECONDS &optional MILLISECONDS NODISP) |
71775
dbb73e0b716b
(sit-for): Doc fix. Specify normal arg list using fn-form.
Kim F. Storm <storm@cua.dk>
parents:
71763
diff
changeset
|
2030 where the optional arg MILLISECONDS specifies an additional wait period, |
71763
bedc73f663be
* subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents:
71726
diff
changeset
|
2031 in milliseconds; this was useful when Emacs was built without |
105629
bdfcf9d2baaa
(error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105364
diff
changeset
|
2032 floating point support." |
80173
0fade0cf2913
(sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents:
80023
diff
changeset
|
2033 (if (numberp nodisp) |
0fade0cf2913
(sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents:
80023
diff
changeset
|
2034 (setq seconds (+ seconds (* 1e-3 nodisp)) |
0fade0cf2913
(sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents:
80023
diff
changeset
|
2035 nodisp obsolete) |
0fade0cf2913
(sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents:
80023
diff
changeset
|
2036 (if obsolete (setq nodisp obsolete))) |
72817
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2037 (cond |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2038 (noninteractive |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2039 (sleep-for seconds) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2040 t) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2041 ((input-pending-p) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2042 nil) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2043 ((<= seconds 0) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2044 (or nodisp (redisplay))) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2045 (t |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2046 (or nodisp (redisplay)) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2047 (let ((read (read-event nil nil seconds))) |
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2048 (or (null read) |
73465
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2049 (progn |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2050 ;; If last command was a prefix arg, e.g. C-u, push this event onto |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2051 ;; unread-command-events as (t . EVENT) so it will be added to |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2052 ;; this-command-keys by read-key-sequence. |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2053 (if (eq overriding-terminal-local-map universal-argument-map) |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2054 (setq read (cons t read))) |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2055 (push read unread-command-events) |
03050ee24abc
(add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents:
73415
diff
changeset
|
2056 nil)))))) |
105631
7cea65998c1f
* subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105629
diff
changeset
|
2057 (set-advertised-calling-convention 'sit-for '(seconds &optional nodisp)) |
20472
79ea90039b23
(read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20410
diff
changeset
|
2058 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2059 ;;; Atomic change groups. |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2060 |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2061 (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
|
2062 "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
|
2063 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
|
2064 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
|
2065 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
|
2066 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2067 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
|
2068 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
|
2069 user can undo the change normally." |
67274
a69df0269000
(atomic-change-group): Add edebug and indentation spec.
John Paul Wallington <jpw@pobox.com>
parents:
67012
diff
changeset
|
2070 (declare (indent 0) (debug t)) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2071 (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
|
2072 (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
|
2073 `(let ((,handle (prepare-change-group)) |
79824
e9adfbf7d96e
(atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents:
79721
diff
changeset
|
2074 ;; Don't truncate any undo data in the middle of this. |
e9adfbf7d96e
(atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents:
79721
diff
changeset
|
2075 (undo-outer-limit nil) |
e9adfbf7d96e
(atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents:
79721
diff
changeset
|
2076 (undo-limit most-positive-fixnum) |
e9adfbf7d96e
(atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents:
79721
diff
changeset
|
2077 (undo-strong-limit most-positive-fixnum) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2078 (,success nil)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2079 (unwind-protect |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2080 (progn |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2081 ;; 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
|
2082 ;; 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
|
2083 ;; 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
|
2084 (activate-change-group ,handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2085 ,@body |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2086 (setq ,success t)) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2087 ;; 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
|
2088 ;; 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
|
2089 (if ,success |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2090 (accept-change-group ,handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2091 (cancel-change-group ,handle)))))) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2092 |
51068
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
2093 (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
|
2094 "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
|
2095 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
|
2096 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2097 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
|
2098 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
|
2099 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2100 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
|
2101 `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
|
2102 `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
|
2103 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
|
2104 `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
|
2105 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
|
2106 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
|
2107 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
|
2108 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
|
2109 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2110 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
|
2111 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
|
2112 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
|
2113 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2114 (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
|
2115 (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
|
2116 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2117 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
|
2118 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
|
2119 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
|
2120 |
51068
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
2121 (if buffer |
4441e202a6f4
(prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents:
51062
diff
changeset
|
2122 (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
|
2123 (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
|
2124 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2125 (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
|
2126 "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
|
2127 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2128 (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
|
2129 (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
|
2130 (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
|
2131 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2132 (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
|
2133 "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
|
2134 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
|
2135 (dolist (elt handle) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2136 (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
|
2137 (if (eq elt t) |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2138 (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
|
2139 |
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2140 (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
|
2141 "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
|
2142 This finishes the change group by reverting all of its changes." |
80023
ac327929a12c
(cancel-change-group): Improve last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
80022
diff
changeset
|
2143 (dolist (elt handle) |
ac327929a12c
(cancel-change-group): Improve last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
80022
diff
changeset
|
2144 (with-current-buffer (car elt) |
ac327929a12c
(cancel-change-group): Improve last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
80022
diff
changeset
|
2145 (setq elt (cdr elt)) |
98071
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2146 (save-restriction |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2147 ;; Widen buffer temporarily so if the buffer was narrowed within |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2148 ;; the body of `atomic-change-group' all changes can be undone. |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2149 (widen) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2150 (let ((old-car |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2151 (if (consp elt) (car elt))) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2152 (old-cdr |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2153 (if (consp elt) (cdr elt)))) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2154 ;; Temporarily truncate the undo log at ELT. |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2155 (when (consp elt) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2156 (setcar elt nil) (setcdr elt nil)) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2157 (unless (eq last-command 'undo) (undo-start)) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2158 ;; Make sure there's no confusion. |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2159 (when (and (consp elt) (not (eq elt (last pending-undo-list)))) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2160 (error "Undoing to some unrelated state")) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2161 ;; Undo it all. |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2162 (save-excursion |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2163 (while (listp pending-undo-list) (undo-more 1))) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2164 ;; Reset the modified cons cell ELT to its original content. |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2165 (when (consp elt) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2166 (setcar elt old-car) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2167 (setcdr elt old-cdr)) |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2168 ;; Revert the undo info to what it was when we grabbed the state. |
c94db6d7eda9
(cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents:
98026
diff
changeset
|
2169 (setq buffer-undo-list elt)))))) |
43126
6f39ff1c6d8f
(atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents:
42941
diff
changeset
|
2170 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2171 ;;;; Display-related functions. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2172 |
44285
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
2173 ;; For compatibility. |
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
2174 (defalias 'redraw-modeline 'force-mode-line-update) |
30505fab0350
(redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents:
44251
diff
changeset
|
2175 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
2176 (defun force-mode-line-update (&optional all) |
52858
b4112065d679
(force-mode-line-update): Fix docstring.
Lute Kamstra <lute@gnu.org>
parents:
52401
diff
changeset
|
2177 "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
|
2178 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
|
2179 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
|
2180 menu bar menus and the frame title." |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2181 (if all (with-current-buffer (other-buffer))) |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
2182 (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
|
2183 |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2184 (defun momentary-string-display (string pos &optional exit-char message) |
114 | 2185 "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
|
2186 Display remains until next event is input. |
75063
394073868e11
(momentary-string-display): After moving point, set POS variable to it to avoid
Juanma Barranquero <lekktu@gmail.com>
parents:
74597
diff
changeset
|
2187 If POS is a marker, only its position is used; its buffer is ignored. |
55187
1bc853c54243
(momentary-string-display): Support EXIT-CHAR that is
Eli Zaretskii <eliz@gnu.org>
parents:
55013
diff
changeset
|
2188 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
|
2189 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
|
2190 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
|
2191 input (as a command if nothing else). |
114 | 2192 Display MESSAGE (optional fourth arg) in the echo area. |
2193 If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there." | |
74242
f4d1181a38c2
(momentary-string-display): "?\ " -> "?\s".
Juanma Barranquero <lekktu@gmail.com>
parents:
74085
diff
changeset
|
2194 (or exit-char (setq exit-char ?\s)) |
95778
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2195 (let ((ol (make-overlay pos pos)) |
107329
4e1ca27d938e
Close bug#5670 with patch from ª©?tª£?pªª¢Ân Nª£?mec <stepnem at gmail.com>.
Glenn Morris <rgm@gnu.org>
parents:
107201
diff
changeset
|
2196 (str (copy-sequence string))) |
114 | 2197 (unwind-protect |
95778
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2198 (progn |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2199 (save-excursion |
107329
4e1ca27d938e
Close bug#5670 with patch from ª©?tª£?pªª¢Ân Nª£?mec <stepnem at gmail.com>.
Glenn Morris <rgm@gnu.org>
parents:
107201
diff
changeset
|
2200 (overlay-put ol 'after-string str) |
95778
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2201 (goto-char pos) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2202 ;; To avoid trouble with out-of-bounds position |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2203 (setq pos (point)) |
107329
4e1ca27d938e
Close bug#5670 with patch from ª©?tª£?pªª¢Ân Nª£?mec <stepnem at gmail.com>.
Glenn Morris <rgm@gnu.org>
parents:
107201
diff
changeset
|
2204 ;; If the string end is off screen, recenter now. |
95778
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2205 (if (<= (window-end nil t) pos) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2206 (recenter (/ (window-height) 2)))) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2207 (message (or message "Type %s to continue editing.") |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2208 (single-key-description exit-char)) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2209 (let (char) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2210 (if (integerp exit-char) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2211 (condition-case nil |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2212 (progn |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2213 (setq char (read-char)) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2214 (or (eq char exit-char) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2215 (setq unread-command-events (list char)))) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2216 (error |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2217 ;; `exit-char' is a character, hence it differs |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2218 ;; from char, which is an event. |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2219 (setq unread-command-events (list char)))) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2220 ;; `exit-char' can be an event, or an event description list. |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2221 (setq char (read-event)) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2222 (or (eq char exit-char) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2223 (eq char (event-convert-list exit-char)) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2224 (setq unread-command-events (list char)))))) |
c9b3cb8a81ec
(momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
95757
diff
changeset
|
2225 (delete-overlay ol)))) |
114 | 2226 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
2227 |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2228 ;;;; Overlay operations |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2229 |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2230 (defun copy-overlay (o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2231 "Return a copy of overlay O." |
107132
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2232 (let ((o1 (if (overlay-buffer o) |
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2233 (make-overlay (overlay-start o) (overlay-end o) |
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2234 ;; FIXME: there's no easy way to find the |
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2235 ;; insertion-type of the two markers. |
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2236 (overlay-buffer o)) |
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2237 (let ((o1 (make-overlay (point-min) (point-min)))) |
6429fc34756a
* subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
106815
diff
changeset
|
2238 (delete-overlay o1) |
107133
a0d4034e4be0
(copy-overlay): Damn typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
107132
diff
changeset
|
2239 o1))) |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2240 (props (overlay-properties o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2241 (while props |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2242 (overlay-put o1 (pop props) (pop props))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2243 o1)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2244 |
55202
4c64ee838f41
* subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents:
55187
diff
changeset
|
2245 (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
|
2246 "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
|
2247 Overlays might be moved and/or split. |
e191e6d1554e
(remove-overlays, read-passwd): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55406
diff
changeset
|
2248 BEG and END default respectively to the beginning and end of buffer." |
73829
201aa7c21cab
(remove-overlays): Call overlay-recenter.
Richard M. Stallman <rms@gnu.org>
parents:
73555
diff
changeset
|
2249 ;; This speeds up the loops over overlays. |
55202
4c64ee838f41
* subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents:
55187
diff
changeset
|
2250 (unless beg (setq beg (point-min))) |
4c64ee838f41
* subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents:
55187
diff
changeset
|
2251 (unless end (setq end (point-max))) |
73943
882d43d66c71
(remove-overlays): Fix last change.
Richard M. Stallman <rms@gnu.org>
parents:
73831
diff
changeset
|
2252 (overlay-recenter end) |
41618
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2253 (if (< end beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2254 (setq beg (prog1 end (setq end beg)))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2255 (save-excursion |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2256 (dolist (o (overlays-in beg end)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2257 (when (eq (overlay-get o name) val) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2258 ;; Either push this overlay outside beg...end |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2259 ;; or split it to exclude beg...end |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2260 ;; 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
|
2261 (if (< (overlay-start o) beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2262 (if (> (overlay-end o) end) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2263 (progn |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2264 (move-overlay (copy-overlay o) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2265 (overlay-start o) beg) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2266 (move-overlay o end (overlay-end o))) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2267 (move-overlay o (overlay-start o) beg)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2268 (if (> (overlay-end o) end) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2269 (move-overlay o end (overlay-end o)) |
812e52cc5162
(copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
41187
diff
changeset
|
2270 (delete-overlay o))))))) |
42917
ec2db12c7670
(copy-without-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
42266
diff
changeset
|
2271 |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
2272 ;;;; Miscellanea. |
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
2273 |
20846
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
2274 (defvar suspend-hook nil |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
2275 "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
|
2276 |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
2277 (defvar suspend-resume-hook nil |
985a277c9b9a
(suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents:
20687
diff
changeset
|
2278 "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
|
2279 |
42083
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
2280 (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
|
2281 "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
|
2282 When the hook runs, the temporary buffer is current, and the window it |
97625
cd9442c3d522
(temp-buffer-show-hook): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
97142
diff
changeset
|
2283 was displayed in is selected.") |
42083
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
2284 |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
2285 (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
|
2286 "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
|
2287 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
|
2288 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
|
2289 mode.") |
981f93cc55d1
(temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents:
42076
diff
changeset
|
2290 |
10254
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
2291 ;; Avoid compiler warnings about this variable, |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
2292 ;; 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
|
2293 (defvar buffer-file-type nil |
1ac3c8fea14a
(font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents:
10178
diff
changeset
|
2294 "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
|
2295 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
|
2296 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
|
2297 On other systems, this variable is normally always nil.") |
68492
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
parents:
68400
diff
changeset
|
2298 |
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
parents:
68400
diff
changeset
|
2299 ;; The `assert' macro from the cl package signals |
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
parents:
68400
diff
changeset
|
2300 ;; `cl-assertion-failed' at runtime so always define it. |
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
parents:
68400
diff
changeset
|
2301 (put 'cl-assertion-failed 'error-conditions '(error)) |
105939
a0f778f4a995
* term/x-win.el (x-gtk-stock-map):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105763
diff
changeset
|
2302 (put 'cl-assertion-failed 'error-message (purecopy "Assertion failed")) |
68492
f4d24a8eaed1
(toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
parents:
68400
diff
changeset
|
2303 |
81338
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2304 (defconst user-emacs-directory |
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2305 (if (eq system-type 'ms-dos) |
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2306 ;; MS-DOS cannot have initial dot. |
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2307 "~/_emacs.d/" |
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2308 "~/.emacs.d/") |
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2309 "Directory beneath which additional per-user Emacs-specific files are placed. |
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2310 Various programs in Emacs store information in this directory. |
99106
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2311 Note that this should end with a directory separator. |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2312 See also `locate-user-emacs-file'.") |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2313 |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2314 (defun locate-user-emacs-file (new-name &optional old-name) |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2315 "Return an absolute per-user Emacs-specific file name. |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2316 If OLD-NAME is non-nil and ~/OLD-NAME exists, return ~/OLD-NAME. |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2317 Else return NEW-NAME in `user-emacs-directory', creating the |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2318 directory if it does not exist." |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2319 (convert-standard-filename |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2320 (let* ((home (concat "~" (or init-file-user ""))) |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2321 (at-home (and old-name (expand-file-name old-name home)))) |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2322 (if (and at-home (file-readable-p at-home)) |
814d2d823dd7
New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents:
98949
diff
changeset
|
2323 at-home |
99184
fc215de0bf93
* subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents:
99124
diff
changeset
|
2324 ;; Make sure `user-emacs-directory' exists, |
fc215de0bf93
* subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents:
99124
diff
changeset
|
2325 ;; unless we're in batch mode or dumping Emacs |
fc215de0bf93
* subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents:
99124
diff
changeset
|
2326 (or noninteractive |
fc215de0bf93
* subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents:
99124
diff
changeset
|
2327 purify-flag |
fc215de0bf93
* subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents:
99124
diff
changeset
|
2328 (file-accessible-directory-p (directory-file-name user-emacs-directory)) |
fc215de0bf93
* subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents:
99124
diff
changeset
|
2329 (make-directory user-emacs-directory)) |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2330 (abbreviate-file-name |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2331 (expand-file-name new-name user-emacs-directory)))))) |
81338
62535fec6ee1
(user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents:
77423
diff
changeset
|
2332 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2333 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2334 ;;;; Misc. useful functions. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2335 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2336 (defun find-tag-default () |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2337 "Determine default tag to search for, based on text at point. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2338 If there is no plausible default, return nil." |
88001
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2339 (let (from to bound) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2340 (when (or (progn |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2341 ;; Look at text around `point'. |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2342 (save-excursion |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2343 (skip-syntax-backward "w_") (setq from (point))) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2344 (save-excursion |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2345 (skip-syntax-forward "w_") (setq to (point))) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2346 (> to from)) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2347 ;; Look between `line-beginning-position' and `point'. |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2348 (save-excursion |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2349 (and (setq bound (line-beginning-position)) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2350 (skip-syntax-backward "^w_" bound) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2351 (> (setq to (point)) bound) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2352 (skip-syntax-backward "w_") |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2353 (setq from (point)))) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2354 ;; Look between `point' and `line-end-position'. |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2355 (save-excursion |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2356 (and (setq bound (line-end-position)) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2357 (skip-syntax-forward "^w_" bound) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2358 (< (setq from (point)) bound) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2359 (skip-syntax-forward "w_") |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2360 (setq to (point))))) |
6cd236e3935c
(find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents:
87974
diff
changeset
|
2361 (buffer-substring-no-properties from to)))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2362 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2363 (defun play-sound (sound) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2364 "SOUND is a list of the form `(sound KEYWORD VALUE...)'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2365 The following keywords are recognized: |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2366 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2367 :file FILE - read sound data from FILE. If FILE isn't an |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2368 absolute file name, it is searched in `data-directory'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2369 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2370 :data DATA - read sound data from string DATA. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2371 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2372 Exactly one of :file or :data must be present. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2373 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2374 :volume VOL - set volume to VOL. VOL must an integer in the |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2375 range 0..100 or a float in the range 0..1.0. If not specified, |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2376 don't change the volume setting of the sound device. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2377 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2378 :device DEVICE - play sound on DEVICE. If not specified, |
101142
1df37db69e4d
* subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents:
101082
diff
changeset
|
2379 a system-dependent default device name is used. |
1df37db69e4d
* subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents:
101082
diff
changeset
|
2380 |
1df37db69e4d
* subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents:
101082
diff
changeset
|
2381 Note: :data and :device are currently not supported on Windows." |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2382 (if (fboundp 'play-sound-internal) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2383 (play-sound-internal sound) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2384 (error "This Emacs binary lacks sound support"))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2385 |
86221
d6b46513e321
(w32-shell-dos-semantics): Declare as function.
Glenn Morris <rgm@gnu.org>
parents:
86172
diff
changeset
|
2386 (declare-function w32-shell-dos-semantics "w32-fns" nil) |
d6b46513e321
(w32-shell-dos-semantics): Declare as function.
Glenn Morris <rgm@gnu.org>
parents:
86172
diff
changeset
|
2387 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2388 (defun shell-quote-argument (argument) |
101142
1df37db69e4d
* subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents:
101082
diff
changeset
|
2389 "Quote ARGUMENT for passing as argument to an inferior shell." |
73125
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2390 (if (or (eq system-type 'ms-dos) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2391 (and (eq system-type 'windows-nt) (w32-shell-dos-semantics))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2392 ;; Quote using double quotes, but escape any existing quotes in |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2393 ;; the argument with backslashes. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2394 (let ((result "") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2395 (start 0) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2396 end) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2397 (if (or (null (string-match "[^\"]" argument)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2398 (< (match-end 0) (length argument))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2399 (while (string-match "[\"]" argument start) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2400 (setq end (match-beginning 0) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2401 result (concat result (substring argument start end) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2402 "\\" (substring argument end (1+ end))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2403 start (1+ end)))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2404 (concat "\"" result (substring argument start) "\"")) |
73125
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2405 (if (equal argument "") |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2406 "''" |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2407 ;; Quote everything except POSIX filename characters. |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2408 ;; This should be safe enough even for really weird shells. |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2409 (let ((result "") (start 0) end) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2410 (while (string-match "[^-0-9a-zA-Z_./]" argument start) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2411 (setq end (match-beginning 0) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2412 result (concat result (substring argument start end) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2413 "\\" (substring argument end (1+ end))) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2414 start (1+ end))) |
c637565b16e8
(shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents:
73028
diff
changeset
|
2415 (concat result (substring argument start)))))) |
69830
196122ba0b05
* subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
69168
diff
changeset
|
2416 |
196122ba0b05
* subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
69168
diff
changeset
|
2417 (defun string-or-null-p (object) |
196122ba0b05
* subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
69168
diff
changeset
|
2418 "Return t if OBJECT is a string or nil. |
196122ba0b05
* subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
69168
diff
changeset
|
2419 Otherwise, return nil." |
196122ba0b05
* subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
69168
diff
changeset
|
2420 (or (stringp object) (null object))) |
196122ba0b05
* subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents:
69168
diff
changeset
|
2421 |
70267
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
2422 (defun booleanp (object) |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
2423 "Return non-nil if OBJECT is one of the two canonical boolean values: t or nil." |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
2424 (memq object '(nil t))) |
a2c45c9f7e1f
(booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
70229
diff
changeset
|
2425 |
70552
1121231ccc23
Revision: emacs@sv.gnu.org/emacs--devo--0--patch-271
Miles Bader <miles@gnu.org>
parents:
70547
diff
changeset
|
2426 (defun field-at-pos (pos) |
101142
1df37db69e4d
* subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents:
101082
diff
changeset
|
2427 "Return the field at position POS, taking stickiness etc into account." |
70547
e184fae4f7dd
(field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
70512
diff
changeset
|
2428 (let ((raw-field (get-char-property (field-beginning pos) 'field))) |
e184fae4f7dd
(field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
70512
diff
changeset
|
2429 (if (eq raw-field 'boundary) |
e184fae4f7dd
(field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
70512
diff
changeset
|
2430 (get-char-property (1- (field-end pos)) 'field) |
e184fae4f7dd
(field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
70512
diff
changeset
|
2431 raw-field))) |
e184fae4f7dd
(field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents:
70512
diff
changeset
|
2432 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2433 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2434 ;;;; Support for yanking and text properties. |
2504
181eef669324
* subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents:
2428
diff
changeset
|
2435 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2436 (defvar yank-excluded-properties) |
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2437 |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2438 (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
|
2439 "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
|
2440 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
|
2441 (let ((inhibit-read-only t)) |
107201
79d3f11c8368
subr.el (remove-yank-excluded-properties): Explain in a comment why `category'
Eli Zaretskii <eliz@gnu.org>
parents:
107133
diff
changeset
|
2442 ;; Replace any `category' property with the properties it stands |
79d3f11c8368
subr.el (remove-yank-excluded-properties): Explain in a comment why `category'
Eli Zaretskii <eliz@gnu.org>
parents:
107133
diff
changeset
|
2443 ;; for. This is to remove `mouse-face' properties that are placed |
79d3f11c8368
subr.el (remove-yank-excluded-properties): Explain in a comment why `category'
Eli Zaretskii <eliz@gnu.org>
parents:
107133
diff
changeset
|
2444 ;; on categories in *Help* buffers' buttons. See |
79d3f11c8368
subr.el (remove-yank-excluded-properties): Explain in a comment why `category'
Eli Zaretskii <eliz@gnu.org>
parents:
107133
diff
changeset
|
2445 ;; http://lists.gnu.org/archive/html/emacs-devel/2002-04/msg00648.html |
79d3f11c8368
subr.el (remove-yank-excluded-properties): Explain in a comment why `category'
Eli Zaretskii <eliz@gnu.org>
parents:
107133
diff
changeset
|
2446 ;; for the details. |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2447 (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
|
2448 (save-excursion |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2449 (goto-char start) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2450 (while (< (point) end) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2451 (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
|
2452 run-end) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2453 (setq run-end |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2454 (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
|
2455 (when cat |
cb548fe4bcdb
(remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents:
47652
diff
changeset
|
2456 (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
|
2457 (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
|
2458 (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
|
2459 (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
|
2460 (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
|
2461 (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
|
2462 (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
|
2463 (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
|
2464 (goto-char run-end))))) |
44980
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2465 (if (eq yank-excluded-properties t) |
5eb4aa56b278
(remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents:
44945
diff
changeset
|
2466 (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
|
2467 (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
|
2468 |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
2469 (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
|
2470 |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
2471 (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
|
2472 "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
|
2473 |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
2474 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
|
2475 (let (to) |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
2476 (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
|
2477 (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
|
2478 (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
|
2479 (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
|
2480 |
6dab9150c9e0
(insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53197
diff
changeset
|
2481 (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
|
2482 "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
|
2483 |
49310
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
2484 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
|
2485 `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
|
2486 |
49363 | 2487 If STRING has a non-nil `yank-handler' property on the first character, |
63258
bd20f5cf580f
(insert-for-yank-1): Fix spellings in docstrings.
Juanma Barranquero <lekktu@gmail.com>
parents:
63151
diff
changeset
|
2488 the normal insert behavior is modified in various ways. The value of |
65014
3aa61588445b
(insert-for-yank-1): Doc fix.
Kim F. Storm <storm@cua.dk>
parents:
64792
diff
changeset
|
2489 the yank-handler property must be a list with one to four elements |
49492
a144c40bb984
(insert-for-yank): Remove COMMAND element from yank handler.
Kim F. Storm <storm@cua.dk>
parents:
49363
diff
changeset
|
2490 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
|
2491 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
|
2492 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
|
2493 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
|
2494 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
|
2495 `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
|
2496 rectangle. |
32fe2d888907
(insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents:
49225
diff
changeset
|
2497 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
|
2498 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
|
2499 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
|
2500 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
|
2501 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
|
2502 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
|
2503 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
|
2504 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
|
2505 (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
|
2506 (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
|
2507 (param (or (nth 1 handler) string)) |
73153
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2508 (opoint (point)) |
75748
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
2509 (inhibit-read-only inhibit-read-only) |
73153
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2510 end) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2511 |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
2512 (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
|
2513 (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
|
2514 (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
|
2515 (insert param)) |
73153
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2516 (setq end (point)) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2517 |
75748
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
2518 ;; Prevent read-only properties from interfering with the |
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
2519 ;; following text property changes. |
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
2520 (setq inhibit-read-only t) |
8c99ad9fd6c0
(insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents:
75347
diff
changeset
|
2521 |
73153
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2522 ;; What should we do with `font-lock-face' properties? |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2523 (if font-lock-defaults |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2524 ;; No, just wipe them. |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2525 (remove-list-of-text-properties opoint end '(font-lock-face)) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2526 ;; Convert them to `face'. |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2527 (save-excursion |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2528 (goto-char opoint) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2529 (while (< (point) end) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2530 (let ((face (get-text-property (point) 'font-lock-face)) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2531 run-end) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2532 (setq run-end |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2533 (next-single-property-change (point) 'font-lock-face nil end)) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2534 (when face |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2535 (remove-text-properties (point) run-end '(font-lock-face nil)) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2536 (put-text-property (point) run-end 'face face)) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2537 (goto-char run-end))))) |
d18b30d3454b
(insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents:
73125
diff
changeset
|
2538 |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
2539 (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
|
2540 (remove-yank-excluded-properties opoint (point))) |
73415
56ea5a847db0
(insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents:
73357
diff
changeset
|
2541 |
56ea5a847db0
(insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents:
73357
diff
changeset
|
2542 ;; If last inserted char has properties, mark them as rear-nonsticky. |
56ea5a847db0
(insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents:
73357
diff
changeset
|
2543 (if (and (> end opoint) |
56ea5a847db0
(insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents:
73357
diff
changeset
|
2544 (text-properties-at (1- end))) |
56ea5a847db0
(insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents:
73357
diff
changeset
|
2545 (put-text-property (1- end) end 'rear-nonsticky t)) |
56ea5a847db0
(insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents:
73357
diff
changeset
|
2546 |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
2547 (if (eq yank-undo-function t) ;; not set by FUNCTION |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
2548 (setq yank-undo-function (nth 3 handler))) ;; UNDO |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
2549 (if (nth 4 handler) ;; COMMAND |
49318
63a122cc4286
(insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents:
49313
diff
changeset
|
2550 (setq this-command (nth 4 handler))))) |
49597
e88404e8f2cf
Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents:
49492
diff
changeset
|
2551 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
2552 (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
|
2553 "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
|
2554 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
|
2555 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
|
2556 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
|
2557 (let ((opoint (point))) |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
2558 (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
|
2559 (let ((inhibit-read-only t)) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
2560 (set-text-properties opoint (point) nil)))) |
f5b7b7055a64
(insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents:
44668
diff
changeset
|
2561 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
2562 (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
|
2563 "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
|
2564 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
|
2565 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
|
2566 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
|
2567 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
|
2568 `yank-excluded-properties'." |
52379 | 2569 ;; Since the buffer text should not normally have yank-handler properties, |
2570 ;; 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
|
2571 (let ((opoint (point))) |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
2572 (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
|
2573 (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
|
2574 |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2575 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2576 ;;;; Synchronous shell commands. |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2577 |
114 | 2578 (defun start-process-shell-command (name buffer &rest args) |
2579 "Start a program in a subprocess. Return the process object for it. | |
2580 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
|
2581 BUFFER is the buffer (or buffer name) to associate with the process. |
114 | 2582 Process output goes at end of that buffer, unless you specify |
2583 an output stream or filter function to handle the output. | |
2584 BUFFER may be also nil, meaning that this process is not associated | |
2585 with any buffer | |
104354
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2586 COMMAND is the shell command to run. |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2587 |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2588 An old calling convention accepted any number of arguments after COMMAND, |
7d0f4f179b3d
* subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104215
diff
changeset
|
2589 which were just concatenated to COMMAND. This is still supported but strongly |
105629
bdfcf9d2baaa
(error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105364
diff
changeset
|
2590 discouraged." |
10025
3b058e13d177
(start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents:
9986
diff
changeset
|
2591 ;; 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
|
2592 ;; but that failed to handle (...) and semicolon, etc. |
97142 | 2593 (start-process name buffer shell-file-name shell-command-switch |
2594 (mapconcat 'identity args " "))) | |
105631
7cea65998c1f
* subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105629
diff
changeset
|
2595 (set-advertised-calling-convention 'start-process-shell-command |
105629
bdfcf9d2baaa
(error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105364
diff
changeset
|
2596 '(name buffer command)) |
105631
7cea65998c1f
* subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105629
diff
changeset
|
2597 |
82094
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2598 (defun start-file-process-shell-command (name buffer &rest args) |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2599 "Start a program in a subprocess. Return the process object for it. |
105629
bdfcf9d2baaa
(error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105364
diff
changeset
|
2600 Similar to `start-process-shell-command', but calls `start-file-process'." |
82094
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2601 (start-file-process |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2602 name buffer |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2603 (if (file-remote-p default-directory) "/bin/sh" shell-file-name) |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2604 (if (file-remote-p default-directory) "-c" shell-command-switch) |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2605 (mapconcat 'identity args " "))) |
105631
7cea65998c1f
* subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105629
diff
changeset
|
2606 (set-advertised-calling-convention 'start-file-process-shell-command |
7cea65998c1f
* subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents:
105629
diff
changeset
|
2607 '(name buffer command)) |
82094
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2608 |
39598
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
2609 (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
|
2610 &rest args) |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
2611 "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
|
2612 The remaining arguments are optional. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
2613 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
|
2614 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
|
2615 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
|
2616 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
|
2617 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
|
2618 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
|
2619 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
|
2620 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
|
2621 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
2622 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
|
2623 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
|
2624 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
|
2625 |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
2626 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
|
2627 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
|
2628 status or a signal description string. |
67884544e4c8
(call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents:
39557
diff
changeset
|
2629 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again." |
97142 | 2630 ;; We used to use `exec' to replace the shell with the command, |
2631 ;; but that failed to handle (...) and semicolon, etc. | |
2632 (call-process shell-file-name | |
2633 infile buffer display | |
2634 shell-command-switch | |
2635 (mapconcat 'identity (cons command args) " "))) | |
82094
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2636 |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2637 (defun process-file-shell-command (command &optional infile buffer display |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2638 &rest args) |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2639 "Process files synchronously in a separate process. |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2640 Similar to `call-process-shell-command', but calls `process-file'." |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2641 (process-file |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2642 (if (file-remote-p default-directory) "/bin/sh" shell-file-name) |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2643 infile buffer display |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2644 (if (file-remote-p default-directory) "-c" shell-command-switch) |
76546b143f2d
* subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents:
81863
diff
changeset
|
2645 (mapconcat 'identity (cons command args) " "))) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
2646 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2647 ;;;; Lisp macros to do various things temporarily. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2648 |
99124
a96e658622b6
(with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents:
99106
diff
changeset
|
2649 (defmacro with-current-buffer (buffer-or-name &rest body) |
a96e658622b6
(with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents:
99106
diff
changeset
|
2650 "Execute the forms in BODY with BUFFER-OR-NAME temporarily current. |
a96e658622b6
(with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents:
99106
diff
changeset
|
2651 BUFFER-OR-NAME must be a buffer or the name of an existing buffer. |
a96e658622b6
(with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents:
99106
diff
changeset
|
2652 The value returned is the value of the last form in BODY. See |
a96e658622b6
(with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents:
99106
diff
changeset
|
2653 also `with-temp-buffer'." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2654 (declare (indent 1) (debug t)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2655 `(save-current-buffer |
99124
a96e658622b6
(with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents:
99106
diff
changeset
|
2656 (set-buffer ,buffer-or-name) |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2657 ,@body)) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2658 |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2659 (defmacro with-selected-window (window &rest body) |
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2660 "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
|
2661 The value returned is the value of the last form in BODY. |
63761
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2662 |
99327
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2663 This macro saves and restores the selected window, as well as the |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2664 selected window of each frame. It does not change the order of |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2665 recently selected windows. If the previously selected window of |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2666 some frame is no longer live at the end of BODY, that frame's |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2667 selected window is left alone. If the selected window is no |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2668 longer live, then whatever window is selected at the end of BODY |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2669 remains selected. |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2670 |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2671 This macro uses `save-current-buffer' to save and restore the |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2672 current buffer, since otherwise its normal operation could |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2673 potentially make a different buffer current. It does not alter |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2674 the buffer list ordering." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2675 (declare (indent 1) (debug t)) |
55828
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
2676 ;; 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
|
2677 `(let ((save-selected-window-window (selected-window)) |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
2678 ;; 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
|
2679 ;; 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
|
2680 ;; frame that window is in. |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
2681 (save-selected-window-alist |
af9432138635
(with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents:
55812
diff
changeset
|
2682 (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
|
2683 (frame-list)))) |
63761
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2684 (save-current-buffer |
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2685 (unwind-protect |
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2686 (progn (select-window ,window 'norecord) |
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2687 ,@body) |
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2688 (dolist (elt save-selected-window-alist) |
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2689 (and (frame-live-p (car elt)) |
f14d5e7e60e1
(with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents:
63664
diff
changeset
|
2690 (window-live-p (cadr elt)) |
99327
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2691 (set-frame-selected-window (car elt) (cadr elt) 'norecord))) |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2692 (when (window-live-p save-selected-window-window) |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2693 (select-window save-selected-window-window 'norecord)))))) |
16277
bbddbc86b82b
(with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
15983
diff
changeset
|
2694 |
83128
2ccd88cfde01
New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents:
55520
diff
changeset
|
2695 (defmacro with-selected-frame (frame &rest body) |
2ccd88cfde01
New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents:
55520
diff
changeset
|
2696 "Execute the forms in BODY with FRAME as the selected frame. |
2ccd88cfde01
New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents:
55520
diff
changeset
|
2697 The value returned is the value of the last form in BODY. |
99327
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2698 |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2699 This macro neither changes the order of recently selected windows |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2700 nor the buffer list." |
83128
2ccd88cfde01
New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents:
55520
diff
changeset
|
2701 (declare (indent 1) (debug t)) |
83488
f47495b26508
Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents:
83483
diff
changeset
|
2702 (let ((old-frame (make-symbol "old-frame")) |
f47495b26508
Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents:
83483
diff
changeset
|
2703 (old-buffer (make-symbol "old-buffer"))) |
f47495b26508
Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents:
83483
diff
changeset
|
2704 `(let ((,old-frame (selected-frame)) |
f47495b26508
Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents:
83483
diff
changeset
|
2705 (,old-buffer (current-buffer))) |
f47495b26508
Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents:
83483
diff
changeset
|
2706 (unwind-protect |
99327
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2707 (progn (select-frame ,frame 'norecord) |
83488
f47495b26508
Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents:
83483
diff
changeset
|
2708 ,@body) |
99327
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2709 (when (frame-live-p ,old-frame) |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2710 (select-frame ,old-frame 'norecord)) |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2711 (when (buffer-live-p ,old-buffer) |
d646820f5ba2
(with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents:
99184
diff
changeset
|
2712 (set-buffer ,old-buffer)))))) |
83128
2ccd88cfde01
New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents:
55520
diff
changeset
|
2713 |
23736 | 2714 (defmacro with-temp-file (file &rest body) |
2715 "Create a new buffer, evaluate BODY there, and write the buffer to FILE. | |
2716 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
|
2717 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
|
2718 (declare (debug t)) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
2719 (let ((temp-file (make-symbol "temp-file")) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2720 (temp-buffer (make-symbol "temp-buffer"))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2721 `(let ((,temp-file ,file) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2722 (,temp-buffer |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2723 (get-buffer-create (generate-new-buffer-name " *temp file*")))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2724 (unwind-protect |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2725 (prog1 |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2726 (with-current-buffer ,temp-buffer |
23736 | 2727 ,@body) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2728 (with-current-buffer ,temp-buffer |
95366
52e3cee99f90
* progmodes/flymake.el (flymake-save-buffer-in-file):
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
94703
diff
changeset
|
2729 (write-region nil nil ,temp-file nil 0))) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2730 (and (buffer-name ,temp-buffer) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2731 (kill-buffer ,temp-buffer)))))) |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2732 |
23736 | 2733 (defmacro with-temp-message (message &rest body) |
24011 | 2734 "Display MESSAGE temporarily if non-nil while BODY is evaluated. |
23736 | 2735 The original message is restored to the echo area after BODY has finished. |
2736 The value returned is the value of the last form in BODY. | |
24011 | 2737 MESSAGE is written to the message log buffer if `message-log-max' is non-nil. |
2738 If MESSAGE is nil, the echo area and message log buffer are unchanged. | |
2739 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
|
2740 (declare (debug t)) |
24000
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
2741 (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
|
2742 (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
|
2743 `(let ((,temp-message ,message) |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
2744 (,current-message)) |
23736 | 2745 (unwind-protect |
2746 (progn | |
24000
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
2747 (when ,temp-message |
2de7db40964d
(with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents:
23907
diff
changeset
|
2748 (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
|
2749 (message "%s" ,temp-message)) |
23736 | 2750 ,@body) |
42076
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
2751 (and ,temp-message |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
2752 (if ,current-message |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
2753 (message "%s" ,current-message) |
d6765861f6ea
(with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents:
41975
diff
changeset
|
2754 (message nil))))))) |
23736 | 2755 |
2756 (defmacro with-temp-buffer (&rest body) | |
2757 "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
|
2758 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
|
2759 (declare (indent 0) (debug t)) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2760 (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
|
2761 `(let ((,temp-buffer (generate-new-buffer " *temp*"))) |
93396
c15f559a5ada
(with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93204
diff
changeset
|
2762 ;; FIXME: kill-buffer can change current-buffer in some odd cases. |
c15f559a5ada
(with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93204
diff
changeset
|
2763 (with-current-buffer ,temp-buffer |
c15f559a5ada
(with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93204
diff
changeset
|
2764 (unwind-protect |
c15f559a5ada
(with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93204
diff
changeset
|
2765 (progn ,@body) |
c15f559a5ada
(with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93204
diff
changeset
|
2766 (and (buffer-name ,temp-buffer) |
c15f559a5ada
(with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93204
diff
changeset
|
2767 (kill-buffer ,temp-buffer))))))) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2768 |
104880
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2769 (defmacro with-silent-modifications (&rest body) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2770 "Execute BODY, pretending it does not modifies the buffer. |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2771 If BODY performs real modifications to the buffer's text, other |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2772 than cosmetic ones, undo data may become corrupted. |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2773 Typically used around modifications of text-properties which do not really |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2774 affect the buffer's content." |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2775 (declare (debug t) (indent 0)) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2776 (let ((modified (make-symbol "modified"))) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2777 `(let* ((,modified (buffer-modified-p)) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2778 (buffer-undo-list t) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2779 (inhibit-read-only t) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2780 (inhibit-modification-hooks t) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2781 deactivate-mark |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2782 ;; Avoid setting and removing file locks and checking |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2783 ;; buffer's uptodate-ness w.r.t the underlying file. |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2784 buffer-file-name |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2785 buffer-file-truename) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2786 (unwind-protect |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2787 (progn |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2788 ,@body) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2789 (unless ,modified |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2790 (restore-buffer-modified-p nil)))))) |
02bf3383a22f
(with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
104737
diff
changeset
|
2791 |
16311
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
2792 (defmacro with-output-to-string (&rest body) |
a56a8c6f2d8f
(with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16294
diff
changeset
|
2793 "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
|
2794 (declare (indent 0) (debug t)) |
16379
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2795 `(let ((standard-output |
dcc3625f52e2
(with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents:
16359
diff
changeset
|
2796 (get-buffer-create (generate-new-buffer-name " *string-output*")))) |
98315
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2797 (unwind-protect |
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2798 (progn |
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2799 (let ((standard-output standard-output)) |
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2800 ,@body) |
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2801 (with-current-buffer standard-output |
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2802 (buffer-string))) |
5053145089c9
(with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents:
98071
diff
changeset
|
2803 (kill-buffer standard-output)))) |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2804 |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2805 (defmacro with-local-quit (&rest body) |
56565
1bef61b14e78
(with-local-quit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
56537
diff
changeset
|
2806 "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
|
2807 When a quit terminates BODY, `with-local-quit' returns nil but |
70903
fe6029063ab4
(with-local-quit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
70901
diff
changeset
|
2808 requests another quit. That quit will be processed as soon as quitting |
fe6029063ab4
(with-local-quit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
70901
diff
changeset
|
2809 is allowed once again. (Immediately, if `inhibit-quit' is nil.)" |
48475
4bdcb09d9f25
(symbol-file): Accept a non-atomic `function' arg.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
48474
diff
changeset
|
2810 (declare (debug t) (indent 0)) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2811 `(condition-case nil |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2812 (let ((inhibit-quit nil)) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2813 ,@body) |
70901
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2814 (quit (setq quit-flag t) |
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2815 ;; This call is to give a chance to handle quit-flag |
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2816 ;; in case inhibit-quit is nil. |
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2817 ;; Without this, it will not be handled until the next function |
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2818 ;; call, and that might allow it to exit thru a condition-case |
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2819 ;; that intends to handle the quit signal next time. |
cc60343f8fd6
(with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents:
70897
diff
changeset
|
2820 (eval '(ignore nil))))) |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
2821 |
58934
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2822 (defmacro while-no-input (&rest body) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2823 "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
|
2824 If input arrives, that ends the execution of BODY, |
64792
f309b64476da
(while-no-input): Return t if there is input.
Richard M. Stallman <rms@gnu.org>
parents:
64762
diff
changeset
|
2825 and `while-no-input' returns t. Quitting makes it return nil. |
f309b64476da
(while-no-input): Return t if there is input.
Richard M. Stallman <rms@gnu.org>
parents:
64762
diff
changeset
|
2826 If BODY finishes, `while-no-input' returns whatever value BODY produced." |
58934
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2827 (declare (debug t) (indent 0)) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2828 (let ((catch-sym (make-symbol "input"))) |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2829 `(with-local-quit |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2830 (catch ',catch-sym |
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2831 (let ((throw-on-input ',catch-sym)) |
72817
b70548506872
(sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents:
72784
diff
changeset
|
2832 (or (input-pending-p) |
92621
f32191b4080d
(while-no-input): Don't splice BODY directly into the `or' form.
Johan Bockgård <bojohan@gnu.org>
parents:
92498
diff
changeset
|
2833 (progn ,@body))))))) |
58934
ee02b41be7da
(while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
58800
diff
changeset
|
2834 |
81803
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2835 (defmacro condition-case-no-debug (var bodyform &rest handlers) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2836 "Like `condition-case' except that it does not catch anything when debugging. |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2837 More specifically if `debug-on-error' is set, then it does not catch any signal." |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2838 (declare (debug condition-case) (indent 2)) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2839 (let ((bodysym (make-symbol "body"))) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2840 `(let ((,bodysym (lambda () ,bodyform))) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2841 (if debug-on-error |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2842 (funcall ,bodysym) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2843 (condition-case ,var |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2844 (funcall ,bodysym) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2845 ,@handlers))))) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2846 |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2847 (defmacro with-demoted-errors (&rest body) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2848 "Run BODY and demote any errors to simple messages. |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2849 If `debug-on-error' is non-nil, run BODY without catching its errors. |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2850 This is to be used around code which is not expected to signal an error |
96361
a99299e4d2de
American English spelling fix.
Glenn Morris <rgm@gnu.org>
parents:
95841
diff
changeset
|
2851 but which should be robust in the unexpected case that an error is signaled." |
81803
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2852 (declare (debug t) (indent 0)) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2853 (let ((err (make-symbol "err"))) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2854 `(condition-case-no-debug ,err |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2855 (progn ,@body) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2856 (error (message "Error: %s" ,err) nil)))) |
f7d2bfbd3abc
*** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
81783
diff
changeset
|
2857 |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2858 (defmacro combine-after-change-calls (&rest body) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2859 "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
|
2860 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
|
2861 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
|
2862 when BODY is finished. |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
2863 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
|
2864 |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2865 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
|
2866 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
|
2867 |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2868 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
|
2869 in BODY." |
51051
b39d8ed2d159
(with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
50694
diff
changeset
|
2870 (declare (indent 0) (debug t)) |
16549
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2871 `(unwind-protect |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2872 (let ((combine-after-change-calls t)) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2873 . ,body) |
30ddd0e52ace
(combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16437
diff
changeset
|
2874 (combine-after-change-execute))) |
76939
1b8e8619079e
* subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents:
76583
diff
changeset
|
2875 |
1b8e8619079e
* subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents:
76583
diff
changeset
|
2876 (defmacro with-case-table (table &rest body) |
1b8e8619079e
* subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents:
76583
diff
changeset
|
2877 "Execute the forms in BODY with TABLE as the current case table. |
1b8e8619079e
* subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents:
76583
diff
changeset
|
2878 The value returned is the value of the last form in BODY." |
1b8e8619079e
* subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents:
76583
diff
changeset
|
2879 (declare (indent 1) (debug t)) |
76960
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2880 (let ((old-case-table (make-symbol "table")) |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2881 (old-buffer (make-symbol "buffer"))) |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2882 `(let ((,old-case-table (current-case-table)) |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2883 (,old-buffer (current-buffer))) |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2884 (unwind-protect |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2885 (progn (set-case-table ,table) |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2886 ,@body) |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2887 (with-current-buffer ,old-buffer |
85841d693997
(with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents:
76939
diff
changeset
|
2888 (set-case-table ,old-case-table)))))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2889 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2890 ;;; Matching and match data. |
44668
52222efc9d4d
(insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents:
44473
diff
changeset
|
2891 |
15955
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
2892 (defvar save-match-data-internal) |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
2893 |
32d772cba2c1
(save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents:
15894
diff
changeset
|
2894 ;; 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
|
2895 ;; 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
|
2896 ;; 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
|
2897 ;; 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
|
2898 (defmacro save-match-data (&rest body) |
43527
d51d403fd80a
(save-match-data): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents:
43498
diff
changeset
|
2899 "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
|
2900 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
|
2901 ;; It is better not to use backquote here, |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2902 ;; because that makes a bootstrapping problem |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2903 ;; 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
|
2904 (declare (indent 0) (debug t)) |
26084
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2905 (list 'let |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2906 '((save-match-data-internal (match-data))) |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2907 (list 'unwind-protect |
804cba424b64
Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents:
26002
diff
changeset
|
2908 (cons 'progn body) |
63664
f29e9a430d73
(save-match-data): Add comment about using evaporate arg
Kim F. Storm <storm@cua.dk>
parents:
63634
diff
changeset
|
2909 ;; It is safe to free (evaporate) markers immediately here, |
f29e9a430d73
(save-match-data): Add comment about using evaporate arg
Kim F. Storm <storm@cua.dk>
parents:
63634
diff
changeset
|
2910 ;; as Lisp programs should not copy from save-match-data-internal. |
63151
cb45242e9d82
(save-match-data): Add RESEAT arg `evaporate' to
Kim F. Storm <storm@cua.dk>
parents:
62861
diff
changeset
|
2911 '(set-match-data save-match-data-internal 'evaporate)))) |
144
535ec1aa78ef
*** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents:
114
diff
changeset
|
2912 |
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
|
2913 (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
|
2914 "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
|
2915 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
|
2916 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
|
2917 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
|
2918 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
|
2919 (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
|
2920 (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
|
2921 (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
|
2922 (buffer-substring (match-beginning num) (match-end num))))) |
10560
fd09d51dfd77
(match-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
10368
diff
changeset
|
2923 |
20491
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2924 (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
|
2925 "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
|
2926 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
|
2927 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
|
2928 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
|
2929 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
|
2930 (if (match-beginning num) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2931 (if string |
53994
342806d7b32b
(match-string-no-properties): Use substring-no-properties.
Eli Zaretskii <eliz@is.elta.co.il>
parents:
53626
diff
changeset
|
2932 (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
|
2933 (match-end num)) |
20491
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2934 (buffer-substring-no-properties (match-beginning num) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2935 (match-end num))))) |
d884af34ba47
(match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents:
20476
diff
changeset
|
2936 |
86017
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2937 |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2938 (defun match-substitute-replacement (replacement |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2939 &optional fixedcase literal string subexp) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2940 "Return REPLACEMENT as it will be inserted by `replace-match'. |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2941 In other words, all back-references in the form `\\&' and `\\N' |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2942 are substituted with actual strings matched by the last search. |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2943 Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2944 meaning as for `replace-match'." |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2945 (let ((match (match-string 0 string))) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2946 (save-match-data |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2947 (set-match-data (mapcar (lambda (x) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2948 (if (numberp x) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2949 (- x (match-beginning 0)) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2950 x)) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2951 (match-data t))) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2952 (replace-match replacement fixedcase literal match subexp)))) |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2953 |
484f09d924cf
(match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents:
85688
diff
changeset
|
2954 |
62861
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2955 (defun looking-back (regexp &optional limit greedy) |
51611
d201fdadadce
(looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
51339
diff
changeset
|
2956 "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
|
2957 Like `looking-at' except matches before point, and is slower. |
72096
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
2958 LIMIT if non-nil speeds up the search by specifying a minimum |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
2959 starting position, to avoid checking matches that would start |
74ec3b24ac69
(dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents:
71961
diff
changeset
|
2960 before LIMIT. |
62861
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2961 |
99356
d0975c52c7cc
(looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
99327
diff
changeset
|
2962 If GREEDY is non-nil, extend the match backwards as far as |
d0975c52c7cc
(looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
99327
diff
changeset
|
2963 possible, stopping when a single additional previous character |
d0975c52c7cc
(looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
99327
diff
changeset
|
2964 cannot be part of a match for REGEXP. When the match is |
99365
a105d0ab85f3
(looking-back): Fix doc-string typo.
Martin Rudalics <rudalics@gmx.at>
parents:
99356
diff
changeset
|
2965 extended, its starting position is allowed to occur before |
99356
d0975c52c7cc
(looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents:
99327
diff
changeset
|
2966 LIMIT." |
62861
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2967 (let ((start (point)) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2968 (pos |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2969 (save-excursion |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2970 (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2971 (point))))) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2972 (if (and greedy pos) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2973 (save-restriction |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2974 (narrow-to-region (point-min) start) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2975 (while (and (> pos (point-min)) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2976 (save-excursion |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2977 (goto-char pos) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2978 (backward-char 1) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2979 (looking-at (concat "\\(?:" regexp "\\)\\'")))) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2980 (setq pos (1- pos))) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2981 (save-excursion |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2982 (goto-char pos) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2983 (looking-at (concat "\\(?:" regexp "\\)\\'"))))) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2984 (not (null pos)))) |
0d5825b4e125
(looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents:
62710
diff
changeset
|
2985 |
81783
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2986 (defsubst looking-at-p (regexp) |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2987 "\ |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2988 Same as `looking-at' except this function does not change the match data." |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2989 (let ((inhibit-changing-match-data t)) |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2990 (looking-at regexp))) |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2991 |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2992 (defsubst string-match-p (regexp string &optional start) |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2993 "\ |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2994 Same as `string-match' except this function does not change the match data." |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2995 (let ((inhibit-changing-match-data t)) |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2996 (string-match regexp string start))) |
f1d802f34413
(looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents:
81765
diff
changeset
|
2997 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2998 (defun subregexp-context-p (regexp pos &optional start) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
2999 "Return non-nil if POS is in a normal subregexp context in REGEXP. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3000 A subregexp context is one where a sub-regexp can appear. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3001 A non-subregexp context is for example within brackets, or within a |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3002 repetition bounds operator `\\=\\{...\\}', or right after a `\\'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3003 If START is non-nil, it should be a position in REGEXP, smaller |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3004 than POS, and known to be in a subregexp context." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3005 ;; Here's one possible implementation, with the great benefit that it |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3006 ;; reuses the regexp-matcher's own parser, so it understands all the |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3007 ;; details of the syntax. A disadvantage is that it needs to match the |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3008 ;; error string. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3009 (condition-case err |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3010 (progn |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3011 (string-match (substring regexp (or start 0) pos) "") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3012 t) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3013 (invalid-regexp |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3014 (not (member (cadr err) '("Unmatched [ or [^" |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3015 "Unmatched \\{" |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3016 "Trailing backslash"))))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3017 ;; An alternative implementation: |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3018 ;; (defconst re-context-re |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3019 ;; (let* ((harmless-ch "[^\\[]") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3020 ;; (harmless-esc "\\\\[^{]") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3021 ;; (class-harmless-ch "[^][]") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3022 ;; (class-lb-harmless "[^]:]") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3023 ;; (class-lb-colon-maybe-charclass ":\\([a-z]+:]\\)?") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3024 ;; (class-lb (concat "\\[\\(" class-lb-harmless |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3025 ;; "\\|" class-lb-colon-maybe-charclass "\\)")) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3026 ;; (class |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3027 ;; (concat "\\[^?]?" |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3028 ;; "\\(" class-harmless-ch |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3029 ;; "\\|" class-lb "\\)*" |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3030 ;; "\\[?]")) ; special handling for bare [ at end of re |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3031 ;; (braces "\\\\{[0-9,]+\\\\}")) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3032 ;; (concat "\\`\\(" harmless-ch "\\|" harmless-esc |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3033 ;; "\\|" class "\\|" braces "\\)*\\'")) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3034 ;; "Matches any prefix that corresponds to a normal subregexp context.") |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3035 ;; (string-match re-context-re (substring regexp (or start 0) pos)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3036 ) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3037 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3038 ;;;; split-string |
51339
14976a545668
(looking-back): New function to check for regular expression before point.
Juanma Barranquero <lekktu@gmail.com>
parents:
51148
diff
changeset
|
3039 |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3040 (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
|
3041 "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
|
3042 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3043 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
|
3044 \(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
|
3045 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3046 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
|
3047 likely to have undesired semantics.") |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3048 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3049 ;; 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
|
3050 ;; 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
|
3051 ;; 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
|
3052 ;; 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
|
3053 (defun split-string (string &optional separators omit-nulls) |
57006
a806a6bbc178
(split-string): Docfix.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents:
56826
diff
changeset
|
3054 "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
|
3055 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3056 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
|
3057 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
|
3058 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
|
3059 which is returned. |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3060 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3061 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
|
3062 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
|
3063 `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
|
3064 OMIT-NULLS is forced to t. |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3065 |
55406
3b27c2f86c7a
(lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents:
55232
diff
changeset
|
3066 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
|
3067 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
|
3068 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
|
3069 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
|
3070 |
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3071 Note that the effect of `(split-string STRING)' is the same as |
75124
f4fe3d3016b1
(split-string): Remove spurious ")" from doc string.
Eli Zaretskii <eliz@gnu.org>
parents:
75106
diff
changeset
|
3072 `(split-string STRING split-string-default-separators t)'. In the rare |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3073 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
|
3074 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
|
3075 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3076 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
|
3077 (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
|
3078 (rexp (or separators split-string-default-separators)) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3079 (start 0) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3080 notfirst |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3081 (list nil)) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3082 (while (and (string-match rexp string |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3083 (if (and notfirst |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3084 (= start (match-beginning 0)) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3085 (< start (length string))) |
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3086 (1+ start) start)) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3087 (< start (length string))) |
20476
f213a5906ea6
(split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents:
20472
diff
changeset
|
3088 (setq notfirst t) |
51148
f59aeee43725
(split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents:
51068
diff
changeset
|
3089 (if (or keep-nulls (< start (match-beginning 0))) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3090 (setq list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3091 (cons (substring string start (match-beginning 0)) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3092 list))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3093 (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
|
3094 (if (or keep-nulls (< start (length string))) |
16314
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3095 (setq list |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3096 (cons (substring string start) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3097 list))) |
c72b7ee606a3
(split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents:
16311
diff
changeset
|
3098 (nreverse list))) |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3099 |
78530
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3100 (defun combine-and-quote-strings (strings &optional separator) |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3101 "Concatenate the STRINGS, adding the SEPARATOR (default \" \"). |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3102 This tries to quote the strings to avoid ambiguity such that |
78530
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3103 (split-string-and-unquote (combine-and-quote-strings strs)) == strs |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3104 Only some SEPARATORs will work properly." |
93825
f0bcbdcf1d54
(combine-and-quote-strings): Also quote strings that contain the separator.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93735
diff
changeset
|
3105 (let* ((sep (or separator " ")) |
f0bcbdcf1d54
(combine-and-quote-strings): Also quote strings that contain the separator.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93735
diff
changeset
|
3106 (re (concat "[\\\"]" "\\|" (regexp-quote sep)))) |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3107 (mapconcat |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3108 (lambda (str) |
93825
f0bcbdcf1d54
(combine-and-quote-strings): Also quote strings that contain the separator.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
93735
diff
changeset
|
3109 (if (string-match re str) |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3110 (concat "\"" (replace-regexp-in-string "[\\\"]" "\\\\\\&" str) "\"") |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3111 str)) |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3112 strings sep))) |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3113 |
78530
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3114 (defun split-string-and-unquote (string &optional separator) |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3115 "Split the STRING into a list of strings. |
78530
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3116 It understands Emacs Lisp quoting within STRING, such that |
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3117 (split-string-and-unquote (combine-and-quote-strings strs)) == strs |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3118 The SEPARATOR regexp defaults to \"\\s-+\"." |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3119 (let ((sep (or separator "\\s-+")) |
98942
24d03d4e9afe
(split-string-and-unquote): Simplify regexp.
Andreas Schwab <schwab@suse.de>
parents:
98939
diff
changeset
|
3120 (i (string-match "\"" string))) |
78530
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3121 (if (null i) |
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3122 (split-string string sep t) ; no quoting: easy |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3123 (append (unless (eq i 0) (split-string (substring string 0 i) sep t)) |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3124 (let ((rfs (read-from-string string i))) |
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3125 (cons (car rfs) |
78530
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3126 (split-string-and-unquote (substring string (cdr rfs)) |
1532be3afc8a
(combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents:
78236
diff
changeset
|
3127 sep))))))) |
78081
d53cb34bfd32
* pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents:
77423
diff
changeset
|
3128 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3129 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3130 ;;;; Replacement in strings. |
24089
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
3131 |
70954a8be49b
(subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents:
24011
diff
changeset
|
3132 (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
|
3133 "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
|
3134 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
|
3135 (let ((i (length string)) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
3136 (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
|
3137 (while (> i 0) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
3138 (setq i (1- i)) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
3139 (if (eq (aref newstr i) fromchar) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
3140 (aset newstr i tochar))) |
1b1555d26963
Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
33833
diff
changeset
|
3141 newstr)) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3142 |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
3143 (defun replace-regexp-in-string (regexp rep string &optional |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
3144 fixedcase literal subexp start) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3145 "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
|
3146 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3147 Return a new string containing the replacements. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3148 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3149 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
|
3150 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
|
3151 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
|
3152 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3153 REP is either a string used as the NEWTEXT arg of `replace-match' or a |
65058
de7df04c6d6b
(replace-regexp-in-string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
65014
diff
changeset
|
3154 function. If it is a function, it is called with the actual text of each |
de7df04c6d6b
(replace-regexp-in-string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
65014
diff
changeset
|
3155 match, and its value is used as the replacement text. When REP is called, |
de7df04c6d6b
(replace-regexp-in-string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
65014
diff
changeset
|
3156 the match-data are the result of matching REGEXP against a substring |
de7df04c6d6b
(replace-regexp-in-string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
65014
diff
changeset
|
3157 of STRING. |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3158 |
28148
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
3159 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
|
3160 and replace a sub-expression, e.g. |
48077
69077a78e52f
(replace-regexp-in-string): Doc fix.
Andreas Schwab <schwab@suse.de>
parents:
47916
diff
changeset
|
3161 (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
|
3162 => \" bar foo\" |
0f14966fe791
(replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents:
28065
diff
changeset
|
3163 " |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3164 |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3165 ;; 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
|
3166 ;; 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
|
3167 ;; 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
|
3168 ;; 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
|
3169 ;; 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
|
3170 ;; [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
|
3171 ;; 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
|
3172 ;; 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
|
3173 ;; 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
|
3174 (let ((l (length string)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3175 (start (or start 0)) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3176 matches str mb me) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3177 (save-match-data |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3178 (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
|
3179 (setq mb (match-beginning 0) |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3180 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
|
3181 ;; 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
|
3182 (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
|
3183 ;; 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
|
3184 ;; 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
|
3185 ;; 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
|
3186 ;; 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
|
3187 ;; 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
|
3188 (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
|
3189 (setq matches |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
3190 (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
|
3191 rep |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
3192 (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
|
3193 fixedcase literal str subexp) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
3194 (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
|
3195 matches))) |
093dcd5f39b2
(replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
27908
diff
changeset
|
3196 (setq start me)) |
27810
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3197 ;; Reconstruct a string from the pieces. |
1d7650c95e0a
(when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents:
27482
diff
changeset
|
3198 (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
|
3199 (apply #'concat (nreverse matches))))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3200 |
106232
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3201 (defun string-prefix-p (str1 str2 &optional ignore-case) |
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3202 "Return non-nil if STR1 is a prefix of STR2. |
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3203 If IGNORE-CASE is non-nil, the comparison is done without paying attention |
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3204 to case differences." |
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3205 (eq t (compare-strings str1 nil nil |
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3206 str2 0 (length str1) ignore-case))) |
f44541b1d13c
(string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
105950
diff
changeset
|
3207 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3208 ;;;; invisibility specs |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3209 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3210 (defun add-to-invisibility-spec (element) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3211 "Add ELEMENT to `buffer-invisibility-spec'. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3212 See documentation for `buffer-invisibility-spec' for the kind of elements |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3213 that can be added." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3214 (if (eq buffer-invisibility-spec t) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3215 (setq buffer-invisibility-spec (list t))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3216 (setq buffer-invisibility-spec |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3217 (cons element buffer-invisibility-spec))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3218 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3219 (defun remove-from-invisibility-spec (element) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3220 "Remove ELEMENT from `buffer-invisibility-spec'." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3221 (if (consp buffer-invisibility-spec) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
3222 (setq buffer-invisibility-spec |
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
3223 (delete element buffer-invisibility-spec)))) |
16359
18cc78dc8b18
(with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents:
16333
diff
changeset
|
3224 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3225 ;;;; Syntax tables. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3226 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3227 (defmacro with-syntax-table (table &rest body) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3228 "Evaluate BODY with syntax table of current buffer set to TABLE. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3229 The syntax table of the current buffer is saved, BODY is evaluated, and the |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3230 saved table is restored, even in case of an abnormal exit. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3231 Value is what BODY returns." |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3232 (declare (debug t)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3233 (let ((old-table (make-symbol "table")) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3234 (old-buffer (make-symbol "buffer"))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3235 `(let ((,old-table (syntax-table)) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3236 (,old-buffer (current-buffer))) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3237 (unwind-protect |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3238 (progn |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3239 (set-syntax-table ,table) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3240 ,@body) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3241 (save-current-buffer |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3242 (set-buffer ,old-buffer) |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3243 (set-syntax-table ,old-table)))))) |
5385
53077bf7c718
(shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents:
5302
diff
changeset
|
3244 |
5844
445de172c217
(make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents:
5460
diff
changeset
|
3245 (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
|
3246 "Return a new syntax table. |
40822
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
3247 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
|
3248 from `standard-syntax-table' otherwise." |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
3249 (let ((table (make-char-table 'syntax-table nil))) |
b10e7d6fb95b
(with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
40282
diff
changeset
|
3250 (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
|
3251 table)) |
17146
b8536e42d4ef
(combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents:
16845
diff
changeset
|
3252 |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
3253 (defun syntax-after (pos) |
61798 | 3254 "Return the raw syntax of the char after POS. |
3255 If POS is outside the buffer's accessible portion, return nil." | |
47355
9e3ee43b5262
(symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47305
diff
changeset
|
3256 (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
|
3257 (let ((st (if parse-sexp-lookup-properties |
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
3258 (get-char-property pos 'syntax-table)))) |
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
3259 (if (consp st) st |
28906724d6e3
(syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
58272
diff
changeset
|
3260 (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
|
3261 |
61669
c95f35bea727
(syntax-class): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
60764
diff
changeset
|
3262 (defun syntax-class (syntax) |
61798 | 3263 "Return the syntax class part of the syntax descriptor SYNTAX. |
3264 If SYNTAX is nil, return nil." | |
3265 (and syntax (logand (car syntax) 65535))) | |
10825
4dba26c66bf5
(global_set_key, local_set_key, global_unset_key)
Richard M. Stallman <rms@gnu.org>
parents:
10794
diff
changeset
|
3266 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3267 ;;;; Text clones |
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
|
3268 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
3269 (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
|
3270 "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
|
3271 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
|
3272 (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
|
3273 (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
|
3274 (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
|
3275 (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
|
3276 (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
|
3277 (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
|
3278 (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
|
3279 ;; 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
|
3280 (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
|
3281 (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
|
3282 (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
|
3283 (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
|
3284 (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
|
3285 (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
|
3286 ;; 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
|
3287 (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
|
3288 (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
|
3289 ;; 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
|
3290 (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
|
3291 (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
|
3292 (+ (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
|
3293 (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
|
3294 ;; 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
|
3295 (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
|
3296 (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
|
3297 (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
|
3298 ;; 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
|
3299 (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
|
3300 (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
|
3301 (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
|
3302 (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
|
3303 (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
|
3304 (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
|
3305 (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
|
3306 (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
|
3307 (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
|
3308 (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
|
3309 ;;(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
|
3310 (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
|
3311 (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
|
3312 (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
|
3313 (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
|
3314 ;;(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
|
3315 )))) |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
3316 (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
|
3317 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
3318 (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
|
3319 "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
|
3320 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
|
3321 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
|
3322 |
7f05eff77ea2
(delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
39725
diff
changeset
|
3323 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
|
3324 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
|
3325 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
|
3326 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
|
3327 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
|
3328 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
|
3329 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
|
3330 ;; 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
|
3331 ;; 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
|
3332 ;; (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
|
3333 ;; 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
|
3334 ;; 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
|
3335 ;; 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
|
3336 ;; `evaporate' to make sure those overlays get deleted when needed). |
47916 | 3337 ;; |
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
|
3338 (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
|
3339 (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
|
3340 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
|
3341 (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
|
3342 (>= 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
|
3343 (>= 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
|
3344 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
|
3345 (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
|
3346 (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
|
3347 (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
|
3348 (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
|
3349 (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
|
3350 (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
|
3351 ;;(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
|
3352 (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
|
3353 (overlay-put ol1 'text-clones dups) |
47916 | 3354 ;; |
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
|
3355 (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
|
3356 (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
|
3357 (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
|
3358 ;;(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
|
3359 (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
|
3360 (overlay-put ol2 'text-clones dups))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3361 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3362 ;;;; Mail user agents. |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3363 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3364 ;; Here we include just enough for other packages to be able |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3365 ;; to define them. |
44422
5f7f8b191a8c
(play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents:
44285
diff
changeset
|
3366 |
47406
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3367 (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
|
3368 &optional abortfunc hookvar) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3369 "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
|
3370 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3371 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
|
3372 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
|
3373 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
|
3374 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3375 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
|
3376 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
|
3377 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
|
3378 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
|
3379 by default. |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3380 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3381 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
|
3382 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
|
3383 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3384 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
|
3385 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3386 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
|
3387 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
|
3388 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
|
3389 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3390 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
|
3391 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
|
3392 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
|
3393 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
|
3394 |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3395 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
|
3396 `abortfunc', and `hookvar'." |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3397 (put symbol 'composefunc composefunc) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3398 (put symbol 'sendfunc sendfunc) |
fbd7a9a8682c
(define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
47355
diff
changeset
|
3399 (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
|
3400 (put symbol 'hookvar (or hookvar 'mail-send-hook))) |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3401 |
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3402 ;;;; Progress reporters. |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3403 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3404 ;; Progress reporter has the following structure: |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3405 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3406 ;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3407 ;; MIN-VALUE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3408 ;; MAX-VALUE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3409 ;; MESSAGE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3410 ;; MIN-CHANGE |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3411 ;; MIN-TIME]) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3412 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3413 ;; This weirdeness is for optimization reasons: we want |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3414 ;; `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
|
3415 ;; `(car reporter)' is better than `(aref reporter 0)'. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3416 ;; |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3417 ;; 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
|
3418 ;; 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
|
3419 ;; hand, it greatly simplifies the code. |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3420 |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3421 (defsubst progress-reporter-update (reporter &optional value) |
57408
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
3422 "Report progress of an operation in the echo area. |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3423 REPORTER should be the result of a call to `make-progress-reporter'. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3424 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3425 If REPORTER is a numerical progress reporter---i.e. if it was |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3426 made using non-nil MIN-VALUE and MAX-VALUE arguments to |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3427 `make-progress-reporter'---then VALUE should be a number between |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3428 MIN-VALUE and MAX-VALUE. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3429 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3430 If REPORTER is a non-numerical reporter, VALUE should be nil. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3431 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3432 This function is relatively inexpensive. If the change since |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3433 last update is too small or insufficient time has passed, it does |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3434 nothing." |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3435 (when (or (not (numberp value)) ; For pulsing reporter |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3436 (>= value (car reporter))) ; For numerical reporter |
57408
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
3437 (progress-reporter-do-update reporter value))) |
601c087f45f6
(progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents:
57384
diff
changeset
|
3438 |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3439 (defun make-progress-reporter (message &optional min-value max-value |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3440 current-value min-change min-time) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3441 "Return progress reporter object for use with `progress-reporter-update'. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3442 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3443 MESSAGE is shown in the echo area, with a status indicator |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3444 appended to the end. When you call `progress-reporter-done', the |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3445 word \"done\" is printed after the MESSAGE. You can change the |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3446 MESSAGE of an existing progress reporter by calling |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3447 `progress-reporter-force-update'. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3448 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3449 MIN-VALUE and MAX-VALUE, if non-nil, are starting (0% complete) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3450 and final (100% complete) states of operation; the latter should |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3451 be larger. In this case, the status message shows the percentage |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3452 progress. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3453 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3454 If MIN-VALUE and/or MAX-VALUE is omitted or nil, the status |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3455 message shows a \"spinning\", non-numeric indicator. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3456 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3457 Optional CURRENT-VALUE is the initial progress; the default is |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3458 MIN-VALUE. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3459 Optional MIN-CHANGE is the minimal change in percents to report; |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3460 the default is 1%. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3461 CURRENT-VALUE and MIN-CHANGE do not have any effect if MIN-VALUE |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3462 and/or MAX-VALUE are nil. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3463 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3464 Optional MIN-TIME specifies the minimum interval time between |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3465 echo area updates (default is 0.2 seconds.) If the function |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3466 `float-time' is not present, time is not tracked at all. If the |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3467 OS is not capable of measuring fractions of seconds, this |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3468 parameter is effectively rounded up." |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3469 (unless min-time |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3470 (setq min-time 0.2)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3471 (let ((reporter |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3472 ;; Force a call to `message' now |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3473 (cons (or min-value 0) |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3474 (vector (if (and (fboundp 'float-time) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3475 (>= min-time 0.02)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3476 (float-time) nil) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3477 min-value |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3478 max-value |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3479 message |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3480 (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
|
3481 min-time)))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3482 (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
|
3483 reporter)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3484 |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3485 (defun progress-reporter-force-update (reporter &optional value new-message) |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3486 "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
|
3487 |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3488 The first two arguments are the same as in `progress-reporter-update'. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3489 NEW-MESSAGE, if non-nil, sets a new message for the reporter." |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3490 (let ((parameters (cdr reporter))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3491 (when new-message |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3492 (aset parameters 3 new-message)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3493 (when (aref parameters 0) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3494 (aset parameters 0 (float-time))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3495 (progress-reporter-do-update reporter value))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3496 |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3497 (defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"] |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3498 "Characters to use for pulsing progress reporters.") |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3499 |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3500 (defun progress-reporter-do-update (reporter value) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3501 (let* ((parameters (cdr reporter)) |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3502 (update-time (aref parameters 0)) |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3503 (min-value (aref parameters 1)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3504 (max-value (aref parameters 2)) |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3505 (text (aref parameters 3)) |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3506 (current-time (float-time)) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3507 (enough-time-passed |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3508 ;; 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
|
3509 (or (not update-time) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3510 (when (>= current-time update-time) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3511 ;; Calculate time for the next update |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3512 (aset parameters 0 (+ update-time (aref parameters 5))))))) |
107573
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3513 (cond ((and min-value max-value) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3514 ;; Numerical indicator |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3515 (let* ((one-percent (/ (- max-value min-value) 100.0)) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3516 (percentage (if (= max-value min-value) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3517 0 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3518 (truncate (/ (- value min-value) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3519 one-percent))))) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3520 ;; Calculate NEXT-UPDATE-VALUE. If we are not printing |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3521 ;; message because not enough time has passed, use 1 |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3522 ;; instead of MIN-CHANGE. This makes delays between echo |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3523 ;; area updates closer to MIN-TIME. |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3524 (setcar reporter |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3525 (min (+ min-value (* (+ percentage |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3526 (if enough-time-passed |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3527 ;; MIN-CHANGE |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3528 (aref parameters 4) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3529 1)) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3530 one-percent)) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3531 max-value)) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3532 (when (integerp value) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3533 (setcar reporter (ceiling (car reporter)))) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3534 ;; Only print message if enough time has passed |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3535 (when enough-time-passed |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3536 (if (> percentage 0) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3537 (message "%s%d%%" text percentage) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3538 (message "%s" text))))) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3539 ;; Pulsing indicator |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3540 (enough-time-passed |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3541 (let ((index (mod (1+ (car reporter)) 4)) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3542 (message-log-max nil)) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3543 (setcar reporter index) |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3544 (message "%s %s" |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3545 text |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3546 (aref progress-reporter--pulse-characters |
954352cc49bd
* subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents:
107329
diff
changeset
|
3547 index))))))) |
57384
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3548 |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3549 (defun progress-reporter-done (reporter) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3550 "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
|
3551 (message "%sdone" (aref (cdr reporter) 3))) |
78290fa43da5
(make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents:
57215
diff
changeset
|
3552 |
59648
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3553 (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
|
3554 "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
|
3555 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
|
3556 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
|
3557 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
|
3558 |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3559 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
|
3560 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
|
3561 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
|
3562 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
|
3563 |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3564 \(fn (VAR COUNT [RESULT]) MESSAGE BODY...)" |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3565 (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
|
3566 (let ((temp (make-symbol "--dotimes-temp--")) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3567 (temp2 (make-symbol "--dotimes-temp2--")) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3568 (start 0) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3569 (end (nth 1 spec))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3570 `(let ((,temp ,end) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3571 (,(car spec) ,start) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3572 (,temp2 (make-progress-reporter ,message ,start ,end))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3573 (while (< ,(car spec) ,temp) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3574 ,@body |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3575 (progress-reporter-update ,temp2 |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3576 (setq ,(car spec) (1+ ,(car spec))))) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3577 (progress-reporter-done ,temp2) |
3054e8b6e73e
(dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
59161
diff
changeset
|
3578 nil ,@(cdr (cdr spec))))) |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3579 |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3580 |
66304
f754be327a7e
Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents:
66286
diff
changeset
|
3581 ;;;; Comparing version strings. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3582 |
105950
e411fa8e0abf
* progmodes/grep.el (grep-regexp-alist):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105944
diff
changeset
|
3583 (defconst version-separator "." |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3584 "*Specify the string used to separate the version elements. |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3585 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3586 Usually the separator is \".\", but it can be any other string.") |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3587 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3588 |
105950
e411fa8e0abf
* progmodes/grep.el (grep-regexp-alist):
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105944
diff
changeset
|
3589 (defconst version-regexp-alist |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3590 '(("^[-_+ ]?a\\(lpha\\)?$" . -3) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
3591 ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases |
73028
66a5ba8082a9
Adjust comment
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
72817
diff
changeset
|
3592 ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3593 ("^[-_+ ]?b\\(eta\\)?$" . -2) |
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3594 ("^[-_+ ]?\\(pre\\|rc\\)$" . -1)) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3595 "*Specify association between non-numeric version and its priority. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3596 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3597 This association is used to handle version string like \"1.0pre2\", |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3598 \"0.9alpha1\", etc. It's used by `version-to-list' (which see) to convert the |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3599 non-numeric part of a version string to an integer. For example: |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3600 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3601 String Version Integer List Version |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3602 \"1.0pre2\" (1 0 -1 2) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3603 \"1.0PRE2\" (1 0 -1 2) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3604 \"22.8beta3\" (22 8 -2 3) |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3605 \"22.8 Beta3\" (22 8 -2 3) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3606 \"0.9alpha1\" (0 9 -3 1) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3607 \"0.9AlphA1\" (0 9 -3 1) |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3608 \"0.9 alpha\" (0 9 -3) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3609 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3610 Each element has the following form: |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3611 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3612 (REGEXP . PRIORITY) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3613 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3614 Where: |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3615 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3616 REGEXP regexp used to match non-numeric part of a version string. |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3617 It should begin with the `^' anchor and end with a `$' to |
65668
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3618 prevent false hits. Letter-case is ignored while matching |
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3619 REGEXP. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3620 |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3621 PRIORITY a negative integer specifying non-numeric priority of REGEXP.") |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3622 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3623 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3624 (defun version-to-list (ver) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3625 "Convert version string VER into a list of integers. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3626 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3627 The version syntax is given by the following EBNF: |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3628 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3629 VERSION ::= NUMBER ( SEPARATOR NUMBER )*. |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3630 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3631 NUMBER ::= (0|1|2|3|4|5|6|7|8|9)+. |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3632 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3633 SEPARATOR ::= `version-separator' (which see) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3634 | `version-regexp-alist' (which see). |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3635 |
65668
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3636 The NUMBER part is optional if SEPARATOR is a match for an element |
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3637 in `version-regexp-alist'. |
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3638 |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3639 Examples of valid version syntax: |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3640 |
65668
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3641 1.0pre2 1.0.7.5 22.8beta3 0.9alpha1 6.9.30Beta |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3642 |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3643 Examples of invalid version syntax: |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3644 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3645 1.0prepre2 1.0..7.5 22.8X3 alpha3.2 .5 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3646 |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3647 Examples of version conversion: |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3648 |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3649 Version String Version as a List of Integers |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3650 \"1.0.7.5\" (1 0 7 5) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3651 \"1.0pre2\" (1 0 -1 2) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3652 \"1.0PRE2\" (1 0 -1 2) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3653 \"22.8beta3\" (22 8 -2 3) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3654 \"22.8Beta3\" (22 8 -2 3) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3655 \"0.9alpha1\" (0 9 -3 1) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3656 \"0.9AlphA1\" (0 9 -3 1) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3657 \"0.9alpha\" (0 9 -3) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3658 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3659 See documentation for `version-separator' and `version-regexp-alist'." |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3660 (or (and (stringp ver) (> (length ver) 0)) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3661 (error "Invalid version string: '%s'" ver)) |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3662 ;; Change .x.y to 0.x.y |
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3663 (if (and (>= (length ver) (length version-separator)) |
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3664 (string-equal (substring ver 0 (length version-separator)) |
77092
055a54275ec3
Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
76960
diff
changeset
|
3665 version-separator)) |
67541
f9d4913b40bc
(version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents:
67274
diff
changeset
|
3666 (setq ver (concat "0" ver))) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3667 (save-match-data |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3668 (let ((i 0) |
65668
bbff73cbd15c
(version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents:
65150
diff
changeset
|
3669 (case-fold-search t) ; ignore case in matching |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3670 lst s al) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3671 (while (and (setq s (string-match "[0-9]+" ver i)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3672 (= s i)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3673 ;; handle numeric part |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3674 (setq lst (cons (string-to-number (substring ver i (match-end 0))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3675 lst) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3676 i (match-end 0)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3677 ;; handle non-numeric part |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3678 (when (and (setq s (string-match "[^0-9]+" ver i)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3679 (= s i)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3680 (setq s (substring ver i (match-end 0)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3681 i (match-end 0)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3682 ;; handle alpha, beta, pre, etc. separator |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3683 (unless (string= s version-separator) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3684 (setq al version-regexp-alist) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3685 (while (and al (not (string-match (caar al) s))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3686 (setq al (cdr al))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3687 (or al (error "Invalid version syntax: '%s'" ver)) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3688 (setq lst (cons (cdar al) lst))))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3689 (if (null lst) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3690 (error "Invalid version syntax: '%s'" ver) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3691 (nreverse lst))))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3692 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3693 |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3694 (defun version-list-< (l1 l2) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3695 "Return t if L1, a list specification of a version, is lower than L2. |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3696 |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3697 Note that a version specified by the list (1) is equal to (1 0), |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3698 \(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant. |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3699 Also, a version given by the list (1) is higher than (1 -1), which in |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3700 turn is higher than (1 -2), which is higher than (1 -3)." |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3701 (while (and l1 l2 (= (car l1) (car l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3702 (setq l1 (cdr l1) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3703 l2 (cdr l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3704 (cond |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3705 ;; l1 not null and l2 not null |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3706 ((and l1 l2) (< (car l1) (car l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3707 ;; l1 null and l2 null ==> l1 length = l2 length |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3708 ((and (null l1) (null l2)) nil) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3709 ;; l1 not null and l2 null ==> l1 length > l2 length |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3710 (l1 (< (version-list-not-zero l1) 0)) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3711 ;; l1 null and l2 not null ==> l2 length > l1 length |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3712 (t (< 0 (version-list-not-zero l2))))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3713 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3714 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3715 (defun version-list-= (l1 l2) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3716 "Return t if L1, a list specification of a version, is equal to L2. |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3717 |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3718 Note that a version specified by the list (1) is equal to (1 0), |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3719 \(1 0 0), (1 0 0 0), etc. That is, the trailing zeros are insignificant. |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3720 Also, a version given by the list (1) is higher than (1 -1), which in |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3721 turn is higher than (1 -2), which is higher than (1 -3)." |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3722 (while (and l1 l2 (= (car l1) (car l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3723 (setq l1 (cdr l1) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3724 l2 (cdr l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3725 (cond |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3726 ;; l1 not null and l2 not null |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3727 ((and l1 l2) nil) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3728 ;; l1 null and l2 null ==> l1 length = l2 length |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3729 ((and (null l1) (null l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3730 ;; l1 not null and l2 null ==> l1 length > l2 length |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3731 (l1 (zerop (version-list-not-zero l1))) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3732 ;; l1 null and l2 not null ==> l2 length > l1 length |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3733 (t (zerop (version-list-not-zero l2))))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3734 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3735 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3736 (defun version-list-<= (l1 l2) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3737 "Return t if L1, a list specification of a version, is lower or equal to L2. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3738 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3739 Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0), |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3740 etc. That is, the trailing zeroes are irrelevant. Also, integer |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3741 list (1) is greater than (1 -1) which is greater than (1 -2) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3742 which is greater than (1 -3)." |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3743 (while (and l1 l2 (= (car l1) (car l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3744 (setq l1 (cdr l1) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3745 l2 (cdr l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3746 (cond |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3747 ;; l1 not null and l2 not null |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3748 ((and l1 l2) (< (car l1) (car l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3749 ;; l1 null and l2 null ==> l1 length = l2 length |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3750 ((and (null l1) (null l2))) |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3751 ;; l1 not null and l2 null ==> l1 length > l2 length |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3752 (l1 (<= (version-list-not-zero l1) 0)) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3753 ;; l1 null and l2 not null ==> l2 length > l1 length |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3754 (t (<= 0 (version-list-not-zero l2))))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3755 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3756 (defun version-list-not-zero (lst) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3757 "Return the first non-zero element of LST, which is a list of integers. |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3758 |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3759 If all LST elements are zeros or LST is nil, return zero." |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3760 (while (and lst (zerop (car lst))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3761 (setq lst (cdr lst))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3762 (if lst |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3763 (car lst) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3764 ;; there is no element different of zero |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3765 0)) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3766 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3767 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3768 (defun version< (v1 v2) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3769 "Return t if version V1 is lower (older) than V2. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3770 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3771 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3772 etc. That is, the trailing \".0\"s are insignificant. Also, version |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3773 string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3774 which is higher than \"1alpha\"." |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3775 (version-list-< (version-to-list v1) (version-to-list v2))) |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3776 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3777 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3778 (defun version<= (v1 v2) |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3779 "Return t if version V1 is lower (older) than or equal to V2. |
65105
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3780 |
aad2616355a4
version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents:
65058
diff
changeset
|
3781 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3782 etc. That is, the trailing \".0\"s are insignificant.. Also, version |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3783 string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3784 which is higher than \"1alpha\"." |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3785 (version-list-<= (version-to-list v1) (version-to-list v2))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3786 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3787 (defun version= (v1 v2) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3788 "Return t if version V1 is equal to V2. |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3789 |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3790 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\", |
107684
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3791 etc. That is, the trailing \".0\"s are insignificant.. Also, version |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3792 string \"1\" is higher (newer) than \"1pre\", which is higher than \"1beta\", |
1d43618b7e72
Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents:
107329
diff
changeset
|
3793 which is higher than \"1alpha\"." |
65150
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3794 (version-list-= (version-to-list v1) (version-to-list v2))) |
6d566cf5ad51
(version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents:
65114
diff
changeset
|
3795 |
104215
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3796 |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3797 ;;; Misc. |
105940
f7147d70f6ef
* subr.el (menu-bar-separator): New defconst.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105939
diff
changeset
|
3798 (defconst menu-bar-separator '("--") |
f7147d70f6ef
* subr.el (menu-bar-separator): New defconst.
Dan Nicolaescu <dann@ics.uci.edu>
parents:
105939
diff
changeset
|
3799 "Separator for menus.") |
104215
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3800 |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3801 ;; The following statement ought to be in print.c, but `provide' can't |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3802 ;; be used there. |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3803 (when (hash-table-p (car (read-from-string |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3804 (prin1-to-string (make-hash-table))))) |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3805 (provide 'hashtable-print-readable)) |
eec5a3966960
* subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents:
103970
diff
changeset
|
3806 |
57151
5350f17d0a78
(event-basic-type): Fix mask (extend to 22bits).
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
57148
diff
changeset
|
3807 ;; arch-tag: f7e0e6e5-70aa-4897-ae72-7a3511ec40bc |
787
3cece0106722
*** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents:
779
diff
changeset
|
3808 ;;; subr.el ends here |