annotate lisp/subr.el @ 112330:56d3e9c28eb0

Merge from mainline.
author Paul Eggert <eggert@cs.ucla.edu>
date Mon, 17 Jan 2011 11:01:01 -0800
parents cc0887b67703
children aa1e27e3a554
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
658
7cbd4fcd8b0f *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 648
diff changeset
1 ;;; subr.el --- basic lisp subroutines for Emacs
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
2
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,
112218
376148b31b5e Add 2011 to FSF/AIST copyright years.
Glenn Morris <rgm@gnu.org>
parents: 111944
diff changeset
4 ;; 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2011
111936
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
5 ;; Free Software Foundation, Inc.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
6
45078
829beb9a6a4b Follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 44980
diff changeset
7 ;; Maintainer: FSF
829beb9a6a4b Follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 44980
diff changeset
8 ;; Keywords: internal
110015
280c8ae2476d Add "Package:" file headers to denote built-in packages.
Chong Yidong <cyd@stupidchicken.com>
parents: 110013
diff changeset
9 ;; Package: emacs
45078
829beb9a6a4b Follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 44980
diff changeset
10
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
11 ;; This file is part of GNU Emacs.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
12
94678
ee5932bf781d Switch to recommended form of GPLv3 permissions notice.
Glenn Morris <rgm@gnu.org>
parents: 94556
diff changeset
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
14 ;; 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
15 ;; 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
16 ;; (at your option) any later version.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
17
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
18 ;; GNU Emacs is distributed in the hope that it will be useful,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
21 ;; GNU General Public License for more details.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
22
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
23 ;; 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
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
25
38414
67b464da13ec Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37070
diff changeset
26 ;;; Commentary:
67b464da13ec Some fixes to follow coding conventions.
Pavel Janík <Pavel@Janik.cz>
parents: 37070
diff changeset
27
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
28 ;;; Code:
98925
5813cf04cdfe (top-level): Require `cl' when compiling.
Eli Zaretskii <eliz@gnu.org>
parents: 98907
diff changeset
29
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
30 (defvar custom-declare-variable-list nil
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
31 "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
32 Each element of this list holds the arguments to one call to `defcustom'.")
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
33
19662
791a40c16c0b Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 19584
diff changeset
34 ;; 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
35 ;; before custom.el.
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
36 (defun custom-declare-variable-early (&rest arguments)
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
37 (setq custom-declare-variable-list
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
38 (cons arguments custom-declare-variable-list)))
44129
444bd245e176 (macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents: 43833
diff changeset
39
87002
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
40 (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
41 "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
42 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
43 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
44 `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
45 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
46 `check-declare' to check for consistency.
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
47
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
48 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
49 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
50 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
51 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
52 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
53 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
54 `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
55 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
56
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
57 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
58 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
59 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
60 `defstruct'.
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
61
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
62 To specify a value for FILEONLY without passing an argument list,
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
63 set ARGLIST to t. This is necessary because nil means an
87002
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
64 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
65
c6a200c4eebd (declare-function): Moved from byte-run.el.
Richard M. Stallman <rms@gnu.org>
parents: 86341
diff changeset
66 Note that for the purposes of `check-declare', this statement
105317
78728d295b59 (declare-function): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 105111
diff changeset
67 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
68
100388
a7231893cd7a (declare-function): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 99633
diff changeset
69 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
70 ;; 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
71 nil)
98939
8d3f352dfa8d Fix last change.
Eli Zaretskii <eliz@gnu.org>
parents: 98925
diff changeset
72
44129
444bd245e176 (macro-declaration-function): New function. Set the
Gerd Moellmann <gerd@gnu.org>
parents: 43833
diff changeset
73
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
74 ;;;; Basic Lisp macros.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
75
40822
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
76 (defalias 'not 'null)
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
77
53197
61703d3393d6 Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents: 53181
diff changeset
78 (defmacro noreturn (form)
67899
7c797468d04b (noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 67876
diff changeset
79 "Evaluate FORM, expecting it not to return.
7c797468d04b (noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 67876
diff changeset
80 If FORM does return, signal an error."
53197
61703d3393d6 Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents: 53181
diff changeset
81 `(prog1 ,form
61703d3393d6 Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents: 53181
diff changeset
82 (error "Form marked with `noreturn' did return")))
61703d3393d6 Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents: 53181
diff changeset
83
61703d3393d6 Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents: 53181
diff changeset
84 (defmacro 1value (form)
67899
7c797468d04b (noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 67876
diff changeset
85 "Evaluate FORM, expecting a constant return value.
7c797468d04b (noreturn, 1value): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 67876
diff changeset
86 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
87 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
88 form)
61703d3393d6 Add macros `1value' and `noreturn'.
Jonathan Yavner <jyavner@member.fsf.org>
parents: 53181
diff changeset
89
71726
a36e654643c1 (def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents: 71151
diff changeset
90 (defmacro def-edebug-spec (symbol spec)
a36e654643c1 (def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents: 71151
diff changeset
91 "Set the `edebug-form-spec' property of SYMBOL according to SPEC.
103884
dbafc1b9107d (def-edebug-spec): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103731
diff changeset
92 Both SYMBOL and SPEC are unevaluated. The SPEC can be:
dbafc1b9107d (def-edebug-spec): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103731
diff changeset
93 0 (instrument no arguments); t (instrument all arguments);
dbafc1b9107d (def-edebug-spec): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103731
diff changeset
94 a symbol (naming a function with an Edebug specification); or a list.
dbafc1b9107d (def-edebug-spec): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103731
diff changeset
95 The elements of the list describe the argument types; see
dbafc1b9107d (def-edebug-spec): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103731
diff changeset
96 \(info \"(elisp)Specification List\") for details."
71726
a36e654643c1 (def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents: 71151
diff changeset
97 `(put (quote ,symbol) 'edebug-form-spec (quote ,spec)))
a36e654643c1 (def-edebug-spec): Moved here.
Richard M. Stallman <rms@gnu.org>
parents: 71151
diff changeset
98
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
99 (defmacro lambda (&rest cdr)
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
100 "Return a lambda expression.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
101 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
102 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
103 expression itself. The lambda expression may then be treated as a
10178
be0081d9ba76 (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10025
diff changeset
104 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
105 `funcall' or `mapcar', etc.
10178
be0081d9ba76 (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 10025
diff changeset
106
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
107 ARGS should take the same form as an argument list for a `defun'.
12395
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
108 DOCSTRING is an optional documentation string.
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
109 If present, it should describe how to call the function.
71727759437e (lambda): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 12296
diff changeset
110 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
111 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
112 It may also be omitted.
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
113 BODY should be a list of Lisp expressions.
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
114
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
115 \(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
116 ;; 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
117 ;; depend on backquote.el.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
118 (list 'function (cons 'lambda cdr)))
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
119
105068
b97679d5a9af * subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents: 105060
diff changeset
120 (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
121 (progn
105060
78c0a7ca3aaf (push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105027
diff changeset
122 ;; 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
123 ;; 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
124 ;; `declare', `push' and `pop'.
25437
95301c74bdd9 Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 25436
diff changeset
125 (defmacro push (newelt listname)
25580
b76f1a72649a (push): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 25469
diff changeset
126 "Add NEWELT to the list stored in the symbol LISTNAME.
25437
95301c74bdd9 Fix previous change.
Richard M. Stallman <rms@gnu.org>
parents: 25436
diff changeset
127 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
128 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
129 (declare (debug (form sexp)))
25469
6762c8a75fd7 (push): Fix typo.
Dave Love <fx@gnu.org>
parents: 25437
diff changeset
130 (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
131 (list 'cons newelt listname)))
25436
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
132
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
133 (defmacro pop (listname)
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
134 "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
135 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
136 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
137 change the list."
51611
d201fdadadce (looking-back): Handle the case of non-trivial regexps.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 51339
diff changeset
138 (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
139 (list 'car
105060
78c0a7ca3aaf (push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105027
diff changeset
140 (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
141 (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
142 ))
25436
d24cf1a4dd34 (push, pop): New macros.
Richard M. Stallman <rms@gnu.org>
parents: 25295
diff changeset
143
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
144 (defmacro when (cond &rest body)
76530
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
145 "If COND yields non-nil, do BODY, else return nil.
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
146 When COND yields non-nil, eval BODY forms sequentially and return
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
147 value of last one, or nil if there are none.
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
148
78149
677d96c34c87 (when, unless): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 78081
diff changeset
149 \(fn COND BODY...)"
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
150 (declare (indent 1) (debug t))
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
151 (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
152
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
153 (defmacro unless (cond &rest body)
76530
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
154 "If COND yields nil, do BODY, else return nil.
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
155 When COND yields nil, eval BODY forms sequentially and return
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
156 value of last one, or nil if there are none.
5813a2f3af13 (when, unless): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 75748
diff changeset
157
78149
677d96c34c87 (when, unless): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 78081
diff changeset
158 \(fn COND BODY...)"
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
159 (declare (indent 1) (debug t))
16845
adc714dc8e3c (when, unless): Definitions moved from cl.el.
Richard M. Stallman <rms@gnu.org>
parents: 16556
diff changeset
160 (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
161
105068
b97679d5a9af * subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents: 105060
diff changeset
162 (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
163 (progn
105060
78c0a7ca3aaf (push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105027
diff changeset
164 ;; 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
165 ;; 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
166 ;; `declare', `push' and `pop'.
72096
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
167 (defvar --dolist-tail-- nil
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
168 "Temporary variable used in `dolist' expansion.")
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
169
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
170 (defmacro dolist (spec &rest body)
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
171 "Loop over a list.
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
172 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
173 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
174
51817
5e9d88e4fcff (dolist, dotimes): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents: 51695
diff changeset
175 \(fn (VAR LIST [RESULT]) BODY...)"
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
176 (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
177 ;; 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
178 ;; 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
179 ;; use dolist.
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
180 (let ((temp '--dolist-tail--))
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
181 `(let ((,temp ,(nth 1 spec))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
182 ,(car spec))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
183 (while ,temp
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
184 (setq ,(car spec) (car ,temp))
72096
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
185 ,@body
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
186 (setq ,temp (cdr ,temp)))
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
187 ,@(if (cdr (cdr spec))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
188 `((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
189
72096
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
190 (defvar --dotimes-limit-- nil
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
191 "Temporary variable used in `dotimes' expansion.")
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
192
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
193 (defmacro dotimes (spec &rest body)
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
194 "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
195 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
196 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
197 the return value (nil if RESULT is omitted).
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
198
51817
5e9d88e4fcff (dolist, dotimes): Doc fix.
Markus Rost <rost@math.uni-bielefeld.de>
parents: 51695
diff changeset
199 \(fn (VAR COUNT [RESULT]) BODY...)"
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
200 (declare (indent 1) (debug dolist))
72096
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
201 ;; 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
202 ;; 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
203 ;; use dotimes.
74ec3b24ac69 (dolist, dotimes): Use interned symbols for iteration.
Richard M. Stallman <rms@gnu.org>
parents: 71961
diff changeset
204 (let ((temp '--dotimes-limit--)
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
205 (start 0)
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
206 (end (nth 1 spec)))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
207 `(let ((,temp ,end)
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
208 (,(car spec) ,start))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
209 (while (< ,(car spec) ,temp)
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
210 ,@body
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
211 (setq ,(car spec) (1+ ,(car spec))))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
212 ,@(cdr (cdr spec)))))
27376
674b7f75841e (dolist, dotimes): Moved from cl-macs.el.
Richard M. Stallman <rms@gnu.org>
parents: 27297
diff changeset
213
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
214 (defmacro declare (&rest specs)
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
215 "Do not evaluate any arguments and return nil.
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
216 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
217 `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
218 nil)
b97679d5a9af * subr.el: Fix last change to avoid using the `unless' macro, which
Chong Yidong <cyd@stupidchicken.com>
parents: 105060
diff changeset
219 ))
94703
4520f20e7dd1 (ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents: 94678
diff changeset
220
4520f20e7dd1 (ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents: 94678
diff changeset
221 (defmacro ignore-errors (&rest body)
4520f20e7dd1 (ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents: 94678
diff changeset
222 "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
223 Otherwise, return result of last form in BODY."
109917
0266442adf6a * subr.el (ignore-errors): Add debug declaration.
Andreas Schwab <schwab@linux-m68k.org>
parents: 109242
diff changeset
224 (declare (debug t) (indent 0))
94703
4520f20e7dd1 (ignore-errors): Move here from cl-macs.el.
Glenn Morris <rgm@gnu.org>
parents: 94678
diff changeset
225 `(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
226
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
227 ;;;; 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
228
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
229 (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
230 "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
231 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
232 (interactive)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
233 nil)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
234
105629
bdfcf9d2baaa (error, sit-for, start-process-shell-command)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105364
diff changeset
235 ;; 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
236 (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
237 "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
238 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
239 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
240 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
241 (while t
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
242 (signal 'error (list (apply 'format args)))))
110356
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
243 (set-advertised-calling-convention 'error '(string &rest args) "23.1")
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
244
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
245 ;; 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
246 ;; 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
247 (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
248 "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
249 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
250 configuration."
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
251 (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
252 (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
253
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
254 (defun functionp (object)
93735
310118b32104 (functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93721
diff changeset
255 "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
256 (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
257 (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
258 (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
259 (error nil))
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
260 (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
261 (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
262 (and (subrp object)
310118b32104 (functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93721
diff changeset
263 ;; Filter out special forms.
310118b32104 (functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93721
diff changeset
264 (not (eq 'unevalled (cdr (subr-arity object)))))
310118b32104 (functionp): Return nil for special forms.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93721
diff changeset
265 (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
266 (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
267
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
268 ;;;; List functions.
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
269
19491
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
270 (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
271 "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
272 (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
273
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
274 (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
275 "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
276 (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
277
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
278 (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
279 "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
280 (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
281
f5fd22f3462c (caar, cadr, cdar, cddr): Definitions moved here and changed into defsubsts.
Richard M. Stallman <rms@gnu.org>
parents: 19176
diff changeset
282 (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
283 "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
284 (cdr (cdr x)))
19492
892a09772457 (last): New function.
Richard M. Stallman <rms@gnu.org>
parents: 19491
diff changeset
285
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
286 (defun last (list &optional n)
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
287 "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
288 If LIST is nil, return nil.
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
289 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
290 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
291 (if n
110972
dff76f22a051 lisp/subr.el (last): Deal with dotted lists (reported in bug#7174).
Juanma Barranquero <lekktu@gmail.com>
parents: 110971
diff changeset
292 (and (>= n 0)
110971
80846b446563 lisp/subr.el (last): Use `safe-length' instead of `length' (bug#7206).
Juanma Barranquero <lekktu@gmail.com>
parents: 110964
diff changeset
293 (let ((m (safe-length list)))
110964
388aaaced495 * lisp/subr.el (last): Make it faster.
Glenn Morris <rgm@gnu.org>
parents: 110742
diff changeset
294 (if (< n m) (nthcdr (- m n) list) list)))
388aaaced495 * lisp/subr.el (last): Make it faster.
Glenn Morris <rgm@gnu.org>
parents: 110742
diff changeset
295 (and list
110971
80846b446563 lisp/subr.el (last): Use `safe-length' instead of `length' (bug#7206).
Juanma Barranquero <lekktu@gmail.com>
parents: 110964
diff changeset
296 (nthcdr (1- (safe-length list)) 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
0bb8dc016c43 (remq): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 47747
diff changeset
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)
111936
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
420 "Like `member', but ignore differences in case and text representation.
28490
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
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
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
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
485 (defun undefined ()
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
486 "Beep to tell the user this binding is undefined."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
487 (interactive)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
488 (ding))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
489
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
490 ;; 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
491 ;; from mentioning keys that run this command.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
492 (put 'undefined 'suppress-keymap t)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
493
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
494 (defun suppress-keymap (map &optional nodigits)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
495 "Make MAP override all normally self-inserting keys to be undefined.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
496 Normally, as an exception, digits and minus-sign are set to make prefix args,
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
497 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
498 (define-key map [remap self-insert-command] 'undefined)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
499 (or nodigits
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
500 (let (loop)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
501 (define-key map "-" 'negative-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
502 ;; Make plain numbers do numeric args.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
503 (setq loop ?0)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
504 (while (<= loop ?9)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
505 (define-key map (char-to-string loop) 'digit-argument)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
506 (setq loop (1+ loop))))))
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
507
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
508 (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
509 "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
510 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
511 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
512 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
513 \(like DEFINITION).
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
514
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
515 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
516 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
517
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
518 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
519
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
520 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
521 (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
522 (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
523 (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
524 (setq key
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
525 (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
526 (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
527 (apply 'vector
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
528 (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
529 (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
530 (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
531 (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
532 ;; 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
533 (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
534 (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
535 ;; 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
536 (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
537 ;; 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
538 ;; 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
539 ;; 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
540 (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
541 (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
542 (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
543 (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
544 (progn
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
545 ;; 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
546 ;; 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
547 ;; 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
548 (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
549 (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
550 ;; 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
551 (or inserted
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
552 (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
553 (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
554 (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
555
93204
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
556 (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
557 "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
558 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
559 (let (list)
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
560 (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
561 keymap)
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
562 (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
563 (lambda (a b)
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
564 (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
565 (if (integerp a)
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
566 (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
567 t)
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
568 (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
569 ;; 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
570 (string< a b))))))
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
571 (dolist (p list)
9f83f0ec5257 * subr.el (map-keymap-sorted): Rename from map-keymap-internal.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93200
diff changeset
572 (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
573
93664
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
574 (defun keymap-canonicalize (map)
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
575 "Return an equivalent keymap, without inheritance."
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
576 (let ((bindings ())
100699
ad20c1d5df89 (keymap-canonicalize): Properly preserve keymap prompt.
Andreas Schwab <schwab@suse.de>
parents: 100676
diff changeset
577 (ranges ())
ad20c1d5df89 (keymap-canonicalize): Properly preserve keymap prompt.
Andreas Schwab <schwab@suse.de>
parents: 100676
diff changeset
578 (prompt (keymap-prompt map)))
93664
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
579 (while (keymapp map)
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
580 (setq map (map-keymap-internal
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
581 (lambda (key item)
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
582 (if (consp key)
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
583 ;; Treat char-ranges specially.
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
584 (push (cons key item) ranges)
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
585 (push (cons key item) bindings)))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
586 map)))
100699
ad20c1d5df89 (keymap-canonicalize): Properly preserve keymap prompt.
Andreas Schwab <schwab@suse.de>
parents: 100676
diff changeset
587 (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
588 (dolist (binding ranges)
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
589 ;; Treat char-ranges specially.
93721
6604d09cf521 *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93664
diff changeset
590 (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
591 (dolist (binding (prog1 bindings (setq bindings ())))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
592 (let* ((key (car binding))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
593 (item (cdr binding))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
594 (oldbind (assq key bindings)))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
595 ;; Newer bindings override older.
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
596 (if oldbind (setq bindings (delq oldbind bindings)))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
597 (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
598 (push binding bindings))))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
599 (nconc map bindings)))
c7dd307b0ec5 * subr.el (keymap-canonicalize): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93396
diff changeset
600
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
601 (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
602
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
603 (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
604 "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
605 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
606 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
607 (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
608 (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
609 (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
610 (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
611
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
612 ;;;; 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
613
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
614 (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
615 "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
616 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
617 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
618 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
619 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
620 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
621
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
622 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
623 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
624 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
625 (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
626 (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
627 (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
628 (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
629
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
630 (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
631 "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
632 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
633 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
634 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
635 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
636 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
637
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
638 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
639 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
640 (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
641 (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
642 (or map
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
643 (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
644 (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
645 (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
646 (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
647
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
648 (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
649 "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
650 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
651 (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
652 (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
653
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
654 (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
655 "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
656 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
657 (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
658 (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
659 (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
660 nil)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
661
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
662 ;;;; 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
663
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
664 (defvar key-substitution-in-progress nil
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
665 "Used internally by `substitute-key-definition'.")
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
666
61967
d9764486d42f (dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents: 61955
diff changeset
667 (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
668 "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
669 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
670 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
671 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
672
68830
a924d28d2d25 (substitute-key-definition): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 68777
diff changeset
673 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
674 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
675 \(define-key KEYMAP [remap OLDDEF] NEWDEF)
f038d760daf1 (substitute-key-definition): Doc fix (hide internal argument).
Juanma Barranquero <lekktu@gmail.com>
parents: 68830
diff changeset
676 \n(fn OLDDEF NEWDEF KEYMAP &optional OLDMAP)"
28868
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
677 ;; 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
678 ;; 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
679 ;; meaning
47916
0bb8dc016c43 (remq): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 47747
diff changeset
680
28868
e62636f5d724 (substitute-key-definition): Add comment describing
Gerd Moellmann <gerd@gnu.org>
parents: 28863
diff changeset
681 ;; 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
682 ;; 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
683 ;; original key, with PREFIX added at the front.
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
684 (or prefix (setq prefix ""))
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
685 (let* ((scan (or oldmap keymap))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
686 (prefix1 (vconcat prefix [nil]))
6167
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
687 (key-substitution-in-progress
1ad8f8ccdc2b (substitute-key-definition): Avoid infinite recursion.
Karl Heuer <kwzh@gnu.org>
parents: 6039
diff changeset
688 (cons scan key-substitution-in-progress)))
1176
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
689 ;; Scan OLDMAP, finding each char or event-symbol that
60e0dc538df3 entered into RCS
Richard M. Stallman <rms@gnu.org>
parents: 1166
diff changeset
690 ;; 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
691 (map-keymap
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
692 (lambda (char defn)
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
693 (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
694 (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
695 scan)))
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
696
61967
d9764486d42f (dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents: 61955
diff changeset
697 (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
698 (let (inner-def skipped menu-item)
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
699 ;; 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
700 (if (eq (car-safe defn) 'menu-item)
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
701 (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
702 ;; Skip past menu-prompt.
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
703 (while (stringp (car-safe defn))
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
704 (push (pop defn) skipped))
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
705 ;; 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
706 (if (consp (car-safe defn))
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
707 (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
708 (if (or (eq defn olddef)
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
709 ;; 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
710 ;; 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
711 (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
712 (equal defn olddef)))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
713 (define-key keymap prefix
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
714 (if menu-item
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
715 (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
716 (setcar (nthcdr 2 copy) newdef)
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
717 copy)
61967
d9764486d42f (dot, dot-marker, dot-min, dot-max, buffer-flush-undo)
Nick Roberts <nickrob@snap.net.nz>
parents: 61955
diff changeset
718 (nconc (nreverse skipped) newdef)))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
719 ;; 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
720 (setq inner-def
68759
0b4b98e12e73 (substitute-key-definition-key): Pass t for NOERROR to
Kim F. Storm <storm@cua.dk>
parents: 68651
diff changeset
721 (or (indirect-function defn t) defn))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
722 ;; 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
723 ;; 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
724 ;; 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
725 (if (and (keymapp inner-def)
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
726 ;; Avoid recursively scanning
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
727 ;; where KEYMAP does not have a submap.
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
728 (let ((elt (lookup-key keymap prefix)))
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
729 (or (null elt) (natnump elt) (keymapp elt)))
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
730 ;; Avoid recursively rescanning keymap being scanned.
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
731 (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
732 ;; 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
733 (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
734
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
735
47916
0bb8dc016c43 (remq): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 47747
diff changeset
736 ;;;; The global keymap tree.
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
737
105060
78c0a7ca3aaf (push, pop, dolist, dotimes, declare): Don't overwrite CL's
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105027
diff changeset
738 ;; 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
739 ;; 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
740
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
741 (defvar global-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
742 "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
743 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
744 global map.")
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
745
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
746 (defvar esc-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
747 "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
748 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
749
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
750 (defvar ctl-x-map nil
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
751 "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
752 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
753
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
754 (defvar ctl-x-4-map (make-sparse-keymap)
41955
241e553840f9 (ctl-x-4-map): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 41618
diff changeset
755 "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
756 (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
757 (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
758
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
759 (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
760 "Keymap for frame commands.")
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
761 (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
762 (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
763
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
764
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
765 ;;;; Event manipulation functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
766
104354
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
767 (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
768
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
769 (defun listify-key-sequence (key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
770 "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
771 (if (vectorp key)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
772 (append key nil)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
773 (mapcar (function (lambda (c)
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
774 (if (> c 127)
3153
4c94c9faf1af (listify-key-sequence): Avoid the constant ?\M-\200.
Richard M. Stallman <rms@gnu.org>
parents: 2963
diff changeset
775 (logxor c listify-key-sequence-1)
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
776 c)))
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
777 key)))
2021
8b9286bffef8 (listify-key-sequence): New function.
Richard M. Stallman <rms@gnu.org>
parents: 1959
diff changeset
778
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
779 (defsubst eventp (obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
780 "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
781 (or (and (integerp obj)
30d4272bcc4b (eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55502
diff changeset
782 ;; 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
783 ;; M is the biggest modifier.
30d4272bcc4b (eventp): Be more discriminating with integers.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 55502
diff changeset
784 (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>
parents: 89909 55976
diff changeset
785 (characterp (event-basic-type obj)))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
786 (and (symbolp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
787 (get obj 'event-symbol-elements))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
788 (and (consp obj)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
789 (symbolp (car obj))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
790 (get (car obj) 'event-symbol-elements))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
791
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
792 (defun event-modifiers (event)
56537
69db3634588e (butlast, event-modifiers, event-basic-type): Doc fixes.
John Paul Wallington <jpw@pobox.com>
parents: 56402
diff changeset
793 "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
794 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
795 `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
796 and `down'.
059dc717baef (event-modifiers, event-basic-type): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 56565
diff changeset
797 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
798 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
799 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
800 even when EVENT actually has modifiers."
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
801 (let ((type event))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
802 (if (listp type)
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
803 (setq type (car type)))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
804 (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
805 ;; 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
806 ;; 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
807 (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
808 (let ((list nil)
aba8cece2157 (event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents: 55008
diff changeset
809 (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
810 ?\H-\^@ ?\s-\^@ ?\A-\^@)))))
aba8cece2157 (event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents: 55008
diff changeset
811 (if (not (zerop (logand type ?\M-\^@)))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
812 (push 'meta list))
55013
aba8cece2157 (event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents: 55008
diff changeset
813 (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
814 (< char 32))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
815 (push 'control list))
55013
aba8cece2157 (event-modifiers): Fix the criterion for ASCII control chars.
Richard M. Stallman <rms@gnu.org>
parents: 55008
diff changeset
816 (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
817 (/= char (downcase char)))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
818 (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
819 (or (zerop (logand type ?\H-\^@))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
820 (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
821 (or (zerop (logand type ?\s-\^@))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
822 (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
823 (or (zerop (logand type ?\A-\^@))
57480
db7d00351c33 (substitute-key-definition-key): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57438
diff changeset
824 (push 'alt list))
2040
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
825 list))))
aa926beb4caa (event-modifiers): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2033
diff changeset
826
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
827 (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
828 "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
829 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
830 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
831 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
832 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
833 (if (consp event)
d2df5ca46b39 * subr.el (event-basic-type): Deal with listy events properly.
Jim Blandy <jimb@redhat.com>
parents: 3591
diff changeset
834 (setq event (car event)))
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
835 (if (symbolp event)
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
836 (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
837 (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
838 (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
839 ;; 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
840 ;; 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
841 (condition-case ()
b54077faa74a (event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents: 62501
diff changeset
842 (downcase uncontrolled)
b54077faa74a (event-basic-type): Don't get an error.
Richard M. Stallman <rms@gnu.org>
parents: 62501
diff changeset
843 (error uncontrolled)))))
2063
2f0555b428c4 (event-basic-type): New function.
Richard M. Stallman <rms@gnu.org>
parents: 2040
diff changeset
844
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
845 (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
846 "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
847 (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
848
94556
8d02ae7cb729 * vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents: 94331
diff changeset
849 (defun mouse-event-p (object)
8d02ae7cb729 * vc.el (vc-dir-mode-map): Enable mouse bindings.
Sam Steingold <sds@gnu.org>
parents: 94331
diff changeset
850 "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
851 ;; 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
852 (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
853
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
854 (defsubst event-start (event)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
855 "Return the starting position of EVENT.
112262
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
856 EVENT should be a click, drag, or key press event.
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
857 If it is a key press event, the return value has the form
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
858 (WINDOW POS (0 . 0) 0)
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
859 If it is a click or drag event, it has the form
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
860 (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
861 IMAGE (DX . DY) (WIDTH . HEIGHT))
112262
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
862 The `posn-' functions access elements of such lists.
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
863 For more information, see Info node `(elisp)Click Events'.
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
864
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
865 If EVENT is a mouse or key press or a mouse click, this is the
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
866 position of the event. If EVENT is a drag, this is the starting
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
867 position of the drag."
45978
a8fbafaa31ad (event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45823
diff changeset
868 (if (consp event) (nth 1 event)
a8fbafaa31ad (event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45823
diff changeset
869 (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
870
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
871 (defsubst event-end (event)
54866
47cdc4f7ee17 (posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54626
diff changeset
872 "Return the ending location of EVENT.
47cdc4f7ee17 (posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54626
diff changeset
873 EVENT should be a click, drag, or key press event.
112262
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
874 If EVENT is a key press event, the return value has the form
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
875 (WINDOW POS (0 . 0) 0)
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
876 If EVENT is a click event, this function is the same as
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
877 `event-start'. For click and drag events, the return value has
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
878 the form
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
879 (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
880 IMAGE (DX . DY) (WIDTH . HEIGHT))
112262
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
881 The `posn-' functions access elements of such lists.
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
882 For more information, see Info node `(elisp)Click Events'.
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
883
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
884 If EVENT is a mouse or key press or a mouse click, this is the
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
885 position of the event. If EVENT is a drag, this is the starting
e4c00899294b * lisp/subr.el (event-start, event-end): Doc fix (Bug#7826).
Chong Yidong <cyd@stupidchicken.com>
parents: 112218
diff changeset
886 position of the drag."
45978
a8fbafaa31ad (event-start, event-end, event-click-count):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 45823
diff changeset
887 (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
888 (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
889
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
890 (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
891 "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
892 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
893 (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
894
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
895 ;;;; 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
896
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
897 (defsubst posn-window (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
898 "Return the window in POSITION.
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
899 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
900 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
901 (nth 0 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
902
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
903 (defsubst posn-area (position)
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
904 "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
905 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
906 and `event-end' functions."
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
907 (let ((area (if (consp (nth 1 position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
908 (car (nth 1 position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
909 (nth 1 position))))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
910 (and (symbolp area) area)))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
911
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
912 (defsubst posn-point (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
913 "Return the buffer location in POSITION.
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
914 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
915 and `event-end' functions."
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
916 (or (nth 5 position)
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
917 (if (consp (nth 1 position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
918 (car (nth 1 position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
919 (nth 1 position))))
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
920
54866
47cdc4f7ee17 (posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54626
diff changeset
921 (defun posn-set-point (position)
47cdc4f7ee17 (posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54626
diff changeset
922 "Move point to POSITION.
47cdc4f7ee17 (posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54626
diff changeset
923 Select the corresponding window as well."
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
924 (if (not (windowp (posn-window position)))
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
925 (error "Position not in text area of window"))
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
926 (select-window (posn-window position))
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
927 (if (numberp (posn-point position))
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
928 (goto-char (posn-point position))))
54866
47cdc4f7ee17 (posn-set-point): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54626
diff changeset
929
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
930 (defsubst posn-x-y (position)
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
931 "Return the x and y coordinates in POSITION.
111905
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
932 The return value has the form (X . Y), where X and Y are given in
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
933 pixels. POSITION should be a list of the form returned by
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
934 `event-start' and `event-end'."
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
935 (nth 2 position))
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
936
95841
b4e36ff621b3 Add some compiler declarations, for builds without X.
Glenn Morris <rgm@gnu.org>
parents: 95778
diff changeset
937 (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
938
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
939 (defun posn-col-row (position)
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
940 "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
941 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
942 and y coordinates in POSITION and the frame's default character width
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
943 and height.
7636
83dba60657ef (posn-col-row): Do something useful for scroll bar event.
Richard M. Stallman <rms@gnu.org>
parents: 7615
diff changeset
944 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
945 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
946 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
947 and `event-end' functions."
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
948 (let* ((pair (posn-x-y position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
949 (window (posn-window position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
950 (area (posn-area position)))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
951 (cond
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
952 ((null window)
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
953 '(0 . 0))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
954 ((eq area 'vertical-scroll-bar)
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
955 (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
956 ((eq area 'horizontal-scroll-bar)
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
957 (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
958 (t
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
959 (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
960 ;; 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
961 ;; newlines into account.
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
962 (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
963 (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
964 line-spacing)
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
965 (frame-parameter frame 'line-spacing)))))
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
966 (cond ((floatp spacing)
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
967 (setq spacing (truncate (* spacing
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
968 (frame-char-height frame)))))
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
969 ((null spacing)
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
970 (setq spacing 0)))
945567648555 * subr.el (posn-col-row): Properly compute line spacing.
Chong Yidong <cyd@stupidchicken.com>
parents: 102658
diff changeset
971 (cons (/ (car pair) (frame-char-width frame))
111615
ab9aebf1b099 subr.el (posn-col-row): Pay attention to header line. (Bug#7390)
Eli Zaretskii <eliz@gnu.org>
parents: 110356
diff changeset
972 (- (/ (cdr pair) (+ (frame-char-height frame) spacing))
111944
9dc65348ace1 subr.el (posn-col-row): Evaluate header-line-format in the context of
Eli Zaretskii <eliz@gnu.org>
parents: 111936
diff changeset
973 (if (null (with-current-buffer (window-buffer window)
9dc65348ace1 subr.el (posn-col-row): Evaluate header-line-format in the context of
Eli Zaretskii <eliz@gnu.org>
parents: 111936
diff changeset
974 header-line-format))
9dc65348ace1 subr.el (posn-col-row): Evaluate header-line-format in the context of
Eli Zaretskii <eliz@gnu.org>
parents: 111936
diff changeset
975 0 1))))))))
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
976
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
977 (defun posn-actual-col-row (position)
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
978 "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
979 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
980 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
981 `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
982 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
983 and `event-end' functions."
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
984 (nth 6 position))
6039
4eb7f4633370 (posn-x-y): New function.
Richard M. Stallman <rms@gnu.org>
parents: 6005
diff changeset
985
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
986 (defsubst posn-timestamp (position)
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
987 "Return the timestamp of POSITION.
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
988 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
989 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
990 (nth 3 position))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
991
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
992 (defsubst posn-string (position)
70229
b85aa1663ba3 (posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 69978
diff changeset
993 "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
994 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
995 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
996 and `event-end' functions."
53132
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
997 (nth 4 position))
20c6299bd4df (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53063
diff changeset
998
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
999 (defsubst posn-image (position)
70229
b85aa1663ba3 (posn-string, posn-image, posn-object): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 69978
diff changeset
1000 "Return the image object of POSITION.
74085
7e5dd39ae47d (posn-image): Fix typo in docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 73943
diff changeset
1001 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
1002 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
1003 and `event-end' functions."
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1004 (nth 7 position))
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1005
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1006 (defsubst posn-object (position)
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1007 "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
1008 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
1009 \(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
1010 POSITION should be a list of the form returned by the `event-start'
53593
39793eabee87 (declare): New macro.
Luc Teirlinck <teirllm@auburn.edu>
parents: 53518
diff changeset
1011 and `event-end' functions."
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1012 (or (posn-image position) (posn-string position)))
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1013
53181
8337e648c2b3 (posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents: 53174
diff changeset
1014 (defsubst posn-object-x-y (position)
8337e648c2b3 (posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents: 53174
diff changeset
1015 "Return the x and y coordinates relative to the object of POSITION.
111905
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
1016 The return value has the form (DX . DY), where DX and DY are
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
1017 given in pixels. POSITION should be a list of the form returned
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
1018 by `event-start' and `event-end'."
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1019 (nth 8 position))
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1020
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1021 (defsubst posn-object-width-height (position)
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1022 "Return the pixel width and height of the object of POSITION.
111905
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
1023 The return value has the form (WIDTH . HEIGHT). POSITION should
0d5ab24d31df Doc fix for posn-* functions (Bug#7471).
Chong Yidong <cyd@stupidchicken.com>
parents: 111615
diff changeset
1024 be a list of the form returned by `event-start' and `event-end'."
53518
21599196e26a (event-start, event-end): Doc fix.
Kim F. Storm <storm@cua.dk>
parents: 53485
diff changeset
1025 (nth 9 position))
53181
8337e648c2b3 (posn-object-x-y): New defun.
Kim F. Storm <storm@cua.dk>
parents: 53174
diff changeset
1026
2071
8f410f56d98f (posn-timestamp, posn-col-row, posn-point, posn-window):
Richard M. Stallman <rms@gnu.org>
parents: 2063
diff changeset
1027
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1028 ;;;; Obsolescent names for functions.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1029
105364
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1030 (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
1031 (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
1032 (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
1033 (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
1034 (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
1035 (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
1036
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1037 (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
1038
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1039 (defun insert-string (&rest args)
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1040 "Mocklisp-compatibility insert function.
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1041 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
1042 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
1043 (dolist (el args)
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1044 (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
1045 (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
1046
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1047 (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
1048 (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
1049
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1050 ;; 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
1051 (defalias 'focus-frame 'ignore "")
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1052 (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
1053 (defalias 'unfocus-frame 'ignore "")
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1054 (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
1055 (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
1056 "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
1057 (make-obsolete 'interactive-p 'called-interactively-p "23.2")
110356
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
1058 (set-advertised-calling-convention 'called-interactively-p '(kind) "23.1")
105763
5041ae86859e (all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105681
diff changeset
1059 (set-advertised-calling-convention
110356
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
1060 'all-completions '(string collection &optional predicate) "23.1")
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
1061 (set-advertised-calling-convention 'unintern '(name obarray) "23.3")
105364
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1062
338d102432df * eval.c (Fcalled_interactively_p): Add `kind' argument.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105317
diff changeset
1063 ;;;; 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
1064
104626
caa79498564a * subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104368
diff changeset
1065 ;; 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
1066 ;; 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
1067 ;; 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
1068 ;; 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
1069 ;; buffer-local.
caa79498564a * subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104368
diff changeset
1070
caa79498564a * subr.el (default-mode-line-format, default-header-line-format)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104368
diff changeset
1071 ;; 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
1072 (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
1073 (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
1074 (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
1075 (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
1076 (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
1077 (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
1078 (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
1079 (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
1080 (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
1081 (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
1082 (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
1083 (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
1084 (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
1085 (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
1086 (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
1087 (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
1088 (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
1089 (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
1090 (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
1091 (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
1092 (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
1093 (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
1094 (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
1095 (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
1096 (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
1097 (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
1098 (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
1099 (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
1100 (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
1101 "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
1102
104920
566d2dc55a9d * keyboard.c (Qmenu_alias, Vdefine_key_rebound_commands): Remove.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104880
diff changeset
1103 (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
1104 (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
1105 (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
1106 (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
1107
c264aa814b15 (redisplay-end-trigger-functions, window-redisplay-end-trigger)
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 92948
diff changeset
1108 (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
1109 (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
1110
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1111 (make-obsolete-variable
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1112 'mode-line-inverse-video
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1113 "use the appropriate faces instead."
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1114 "21.1")
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1115 (make-obsolete-variable
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1116 'unread-command-char
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1117 "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
1118 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
1119 "before 19.15")
46537
46f175ecf5d4 (unread-command-char, executing-macro, post-command-idle-hook,
Juanma Barranquero <lekktu@gmail.com>
parents: 46532
diff changeset
1120
62015
e208ebaf0e17 (executing-macro): Use `define-obsolete-variable-alias'.
Luc Teirlinck <teirllm@auburn.edu>
parents: 61996
diff changeset
1121 ;; Lisp manual only updated in 22.1.
e208ebaf0e17 (executing-macro): Use `define-obsolete-variable-alias'.
Luc Teirlinck <teirllm@auburn.edu>
parents: 61996
diff changeset
1122 (define-obsolete-variable-alias 'executing-macro 'executing-kbd-macro
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1123 "before 19.34")
62015
e208ebaf0e17 (executing-macro): Use `define-obsolete-variable-alias'.
Luc Teirlinck <teirllm@auburn.edu>
parents: 61996
diff changeset
1124
57778
82ed9ce364a7 (x-lost-selection-hooks, x-sent-selection-hooks): New obsolete aliases
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 57689
diff changeset
1125 (defvaralias 'x-lost-selection-hooks 'x-lost-selection-functions)
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1126 (make-obsolete-variable 'x-lost-selection-hooks
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1127 '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
1128 (defvaralias 'x-sent-selection-hooks 'x-sent-selection-functions)
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1129 (make-obsolete-variable 'x-sent-selection-hooks
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1130 '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
1131
102032
5ff1f67594ee (translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents: 102010
diff changeset
1132 ;; 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
1133 ;; 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
1134 ;; 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
1135 ;; but Stefan insists to mark it so.
5ff1f67594ee (translation-table-for-input): Declare obsolete again.
Eli Zaretskii <eliz@gnu.org>
parents: 102010
diff changeset
1136 (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
1137
59124
f38536b30f3a (messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents: 58934
diff changeset
1138 (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
1139
0e99f90c4347 (last-input-char, last-command-char): Move here from src/keyboard.c.
Glenn Morris <rgm@gnu.org>
parents: 100908
diff changeset
1140 ;; 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
1141 ;; only marked as obsolete in 23.1.
101082
a69b4c107ea4 Comment (fix typo).
Glenn Morris <rgm@gnu.org>
parents: 100997
diff changeset
1142 ;; 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
1143 ;; 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
1144 (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
1145 "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
1146 (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
1147 "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
1148
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1149
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1150 ;;;; 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
1151
62542
3f80c5cf6771 (send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 62524
diff changeset
1152 (defalias 'send-string 'process-send-string)
3f80c5cf6771 (send-string, send-region): Remove obsolescence declaration.
Juanma Barranquero <lekktu@gmail.com>
parents: 62524
diff changeset
1153 (defalias 'send-region 'process-send-region)
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1154 (defalias 'string= 'string-equal)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1155 (defalias 'string< 'string-lessp)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1156 (defalias 'move-marker 'set-marker)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1157 (defalias 'rplaca 'setcar)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1158 (defalias 'rplacd 'setcdr)
3591
507f64624555 Apply typo patches from Paul Eggert.
Jim Blandy <jimb@redhat.com>
parents: 3411
diff changeset
1159 (defalias 'beep 'ding) ;preserve lingual purity
2569
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1160 (defalias 'indent-to-column 'indent-to)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1161 (defalias 'backward-delete-char 'delete-backward-char)
39ad4eda7fea All fsets changed to defaliases.
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 2504
diff changeset
1162 (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
1163 (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
1164 (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
1165 (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
1166 (defalias 'chmod 'set-file-modes)
100751
2935e76b69a8 (mkdir): New defalias.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 100699
diff changeset
1167 (defalias 'mkdir 'make-directory)
31563
96b9757bfd45 (add-minor-mode): Use toggle-fun arg.
Dave Love <fx@gnu.org>
parents: 30515
diff changeset
1168 ;; These are the XEmacs names:
25293
fd43e1a99384 (point-at-eol, point-at-bol): New aliases.
Karl Heuer <kwzh@gnu.org>
parents: 25140
diff changeset
1169 (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
1170 (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
1171
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1172 (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
1173
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1174
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1175 ;;;; Hook manipulation functions.
388
498bcec1cf3a *** empty log message ***
Jim Blandy <jimb@redhat.com>
parents: 384
diff changeset
1176
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
1177 (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
1178 "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
1179 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
1180 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
1181 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
1182 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
1183
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
1184 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
1185 the hook's buffer-local value rather than its default value.
43435
c7aaafe7f385 (add-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 43158
diff changeset
1186 This makes the hook buffer-local if needed, and it makes t a member
c7aaafe7f385 (add-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 43158
diff changeset
1187 of the buffer-local value. That acts as a flag to run the hook
c7aaafe7f385 (add-hook): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 43158
diff changeset
1188 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
1189
4414
3356419b94c1 (add-hook): Change a single function into a list.
Richard M. Stallman <rms@gnu.org>
parents: 4235
diff changeset
1190 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
1191 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
1192 function, it is changed to a list of functions."
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1193 (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
1194 (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
1195 (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
1196 (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
1197 ;; 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
1198 ;; and do what we used to do.
52987
ac21698ba968 (add-hook): Fix last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 52896
diff changeset
1199 (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
1200 (setq local t)))
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
1201 (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
1202 ;; 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
1203 (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
1204 (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
1205 ;; 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
1206 (unless (member function hook-value)
105944
a465c7c7e59e * subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105940
diff changeset
1207 (when (stringp function)
a465c7c7e59e * subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105940
diff changeset
1208 (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
1209 (setq hook-value
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
1210 (if append
6430ce03c28a (add-hook, remove-hook): Make hook buffer-local if needed..
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 28811
diff changeset
1211 (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
1212 (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
1213 ;; Set the actual variable
87974
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1214 (if local
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1215 (progn
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1216 ;; 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
1217 ;; 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
1218 ;; mark HOOK as partially permanent.
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1219 (and (symbolp function)
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1220 (get function 'permanent-local-hook)
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1221 (not (get hook 'permanent-local))
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1222 (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
1223 (set hook hook-value))
97c3cc0a167b (add-hook): Implement `permanent-local-hook' property.
Richard M. Stallman <rms@gnu.org>
parents: 87903
diff changeset
1224 (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
1225
9195
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
1226 (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
1227 "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
1228 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
1229 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
1230 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
1231
70b00615cb75 (add-hook): Initialize default value and local value.
Richard M. Stallman <rms@gnu.org>
parents: 8959
diff changeset
1232 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
1233 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
1234 (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
1235 (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
1236 ;; 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
1237 (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
1238 ;; 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
1239 ;; 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
1240 (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
1241 (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
1242 (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
1243 (setq local t))
f992824e67f0 (add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents: 52858
diff changeset
1244 (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
1245 ;; 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
1246 (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
1247 (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
1248 (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
1249 ;; 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
1250 ;;(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
1251 ;; (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
1252 ;; (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
1253 ;; 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
1254 (if (not local)
f992824e67f0 (add-hook): Correctly detect when make-local-hook was used.
Richard M. Stallman <rms@gnu.org>
parents: 52858
diff changeset
1255 (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
1256 (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
1257 (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
1258 (set hook hook-value))))))
9510
f03544494d1c (add-to-list): New function.
Richard M. Stallman <rms@gnu.org>
parents: 9202
diff changeset
1259
72784
3f19250c6e68 (add-to-list): New argument COMPARE-FN.
Richard M. Stallman <rms@gnu.org>
parents: 72138
diff changeset
1260 (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
1261 "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
1262 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
1263 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
1264 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
1265 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
1266 ELEMENT is added at the end.
24757
f4127409d184 (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 24699
diff changeset
1267
43833
37bc1e73d4b3 (add-to-list): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 43527
diff changeset
1268 The return value is the new value of LIST-VAR.
37bc1e73d4b3 (add-to-list): Doc fix.
Pavel Janík <Pavel@Janik.cz>
parents: 43527
diff changeset
1269
9535
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
1270 If you want to use `add-to-list' on a variable that is not defined
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
1271 until a certain package is loaded, you should put the call to `add-to-list'
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
1272 into a hook function that will be run only after loading the package.
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
1273 `eval-after-load' provides one way to do this. In some cases
a2908d5da32a (add-to-list): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 9510
diff changeset
1274 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
1275 (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
1276 ((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
1277 (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
1278 ((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
1279 (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
1280 ((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
1281 (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
1282 (t
73555
3f351640d09f (add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents: 73466
diff changeset
1283 (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
1284 (while (and lst
3f351640d09f (add-to-list): Don't continue checking if a match has
David Kastrup <dak@gnu.org>
parents: 73466
diff changeset
1285 (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
1286 (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
1287 lst)))
21409
3e8b7782f4f5 (add-to-list): Always return updated value of LIST-VAR.
Karl Heuer <kwzh@gnu.org>
parents: 21173
diff changeset
1288 (symbol-value list-var)
32355
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
1289 (set list-var
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
1290 (if append
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
1291 (append (symbol-value list-var) (list element))
6bf2ae19e286 (add-to-list): Add optional argument APPEND.
Miles Bader <miles@gnu.org>
parents: 32131
diff changeset
1292 (cons element (symbol-value list-var))))))
39725
c64d3e3adf5d (symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents: 39598
diff changeset
1293
63387
5b9f98f257f8 (add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents: 63381
diff changeset
1294
5b9f98f257f8 (add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents: 63381
diff changeset
1295 (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
1296 "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
1297 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
1298
5b9f98f257f8 (add-to-ordered-list): New defun.
Kim F. Storm <storm@cua.dk>
parents: 63381
diff changeset
1299 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
1300 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
1301 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
1302
63797
7f964f8f5c85 (add-to-list, add-to-ordered-list): Doc fixes.
Luc Teirlinck <teirllm@auburn.edu>
parents: 63761
diff changeset
1303 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
1304 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
1305 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
1306 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
1307 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
1308
63472
a89b059224fb (add-to-ordered-list): Use a weak hash-table to avoid leaks.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 63396
diff changeset
1309 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
1310 `list-order' property.
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 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
1313 (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
1314 (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
1315 (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
1316 (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
1317 (when order
63605
99743da5284f (add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents: 63472
diff changeset
1318 (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
1319 (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
1320 (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
1321 (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
1322 (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
1323 (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
1324 (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
1325 (if (and oa ob)
99743da5284f (add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents: 63472
diff changeset
1326 (< oa ob)
99743da5284f (add-to-ordered-list): Test membership with eq. Simplify.
Kim F. Storm <storm@cua.dk>
parents: 63472
diff changeset
1327 oa)))))))
70415
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1328
70678
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1329 (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
1330 "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
1331 Return the new history list.
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1332 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
1333 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
1334 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
1335 variable.
70678
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1336 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
1337 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
1338 if it is empty or a duplicate."
70415
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1339 (unless maxelt
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1340 (setq maxelt (or (get history-var 'history-length)
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1341 history-length)))
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1342 (let ((history (symbol-value history-var))
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1343 tail)
70678
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1344 (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
1345 (or keep-all
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1346 (not (stringp newelt))
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1347 (> (length newelt) 0))
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1348 (or keep-all
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1349 (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
1350 (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
1351 (delete newelt history))
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1352 (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
1353 (when (integerp maxelt)
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1354 (if (= 0 maxelt)
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1355 (setq history nil)
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1356 (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
1357 (when (consp tail)
a561e5346aa8 (add-to-history): Add KEEP-ALL arg and align functionality
Kim F. Storm <storm@cua.dk>
parents: 70552
diff changeset
1358 (setcdr tail nil)))))
70415
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1359 (set history-var history)))
72f273a616c1 (add-to-history): New function.
Kim F. Storm <storm@cua.dk>
parents: 70267
diff changeset
1360
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1361
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1362 ;;;; Mode hooks.
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1363
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1364 (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
1365 "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
1366 (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
1367 "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
1368 (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
1369 (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
1370
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1371 (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
1372 "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
1373
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1374 (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
1375 "Run mode hooks `delayed-mode-hooks' and HOOKS, or delay HOOKS.
111936
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
1376 Execution is delayed if the variable `delay-mode-hooks' is non-nil.
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
1377 Otherwise, runs the mode hooks and then `after-change-major-mode-hook'.
81765
7effaa2c79bd (run-mode-hooks): Docstring improvement.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81646
diff changeset
1378 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
1379 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
1380 (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
1381 ;; Delaying case.
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1382 (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
1383 (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
1384 ;; 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
1385 (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
1386 (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
1387 (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
1388 (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
1389
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1390 (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
1391 "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
1392 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
1393 `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
1394 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
1395 (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
1396 `(progn
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1397 (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
1398 (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
1399 ,@body)))
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1400
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1401 ;; 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
1402
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1403 (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
1404 "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
1405 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
1406 (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
1407 (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
1408 (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
1409 parent))
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1410
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1411 ;;;; Minor modes.
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1412
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1413 ;; 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
1414 ;; 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
1415 ;; 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
1416 ;; 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
1417 (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
1418 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
1419 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
1420 "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
1421
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1422 (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
1423 "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
1424
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1425 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
1426
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1427 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
1428 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
1429
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1430 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
1431 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
1432 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
1433
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1434 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
1435 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
1436
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1437 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
1438 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
1439
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1440 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
1441 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
1442
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1443 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
1444 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
1445 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
1446 (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
1447 (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
1448
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1449 (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
1450 (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
1451 (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
1452 ;; 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
1453 (when name
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1454 (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
1455 (if existing
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1456 (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
1457 (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
1458 (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
1459 (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
1460 (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
1461 (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
1462 (if found
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1463 (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
1464 (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
1465 (nconc found (list (list toggle name)) rest))
108243
be3f6d650654 Minor cleanups.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108006
diff changeset
1466 (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
1467 ;; 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
1468 (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
1469 (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
1470 (vector toggle)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1471 (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
1472 (concat
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1473 (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
1474 (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
1475 (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
1476 (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
1477 (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
1478 toggle-fun
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1479 :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
1480
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 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
1482 (when keymap
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1483 (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
1484 (if existing
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1485 (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
1486 (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
1487 (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
1488 (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
1489 (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
1490 (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
1491 (if found
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1492 (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
1493 (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
1494 (nconc found (list (cons toggle keymap)) rest))
108243
be3f6d650654 Minor cleanups.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108006
diff changeset
1495 (push (cons toggle keymap) minor-mode-map-alist)))))))
39725
c64d3e3adf5d (symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents: 39598
diff changeset
1496
c64d3e3adf5d (symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents: 39598
diff changeset
1497 ;;; Load history
c64d3e3adf5d (symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents: 39598
diff changeset
1498
59124
f38536b30f3a (messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents: 58934
diff changeset
1499 (defun symbol-file (symbol &optional type)
98026
1965167a6de7 (symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents: 97882
diff changeset
1500 "Return the name of the file that defined SYMBOL.
1965167a6de7 (symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents: 97882
diff changeset
1501 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
1502 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
1503 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
1504 file name without extension.
1965167a6de7 (symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents: 97882
diff changeset
1505
1965167a6de7 (symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents: 97882
diff changeset
1506 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
1507 TYPE is `defun', `defvar', or `defface', that specifies function
1965167a6de7 (symbol-file): Fix doc-string.
Martin Rudalics <rudalics@gmx.at>
parents: 97882
diff changeset
1508 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
1509 (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
1510 (symbolp symbol) (fboundp symbol)
f38536b30f3a (messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents: 58934
diff changeset
1511 (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
1512 (nth 1 (symbol-function symbol))
47355
9e3ee43b5262 (symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47305
diff changeset
1513 (let ((files load-history)
48474
33dafec6a9de (symbol-file): Remove unused variable `functions'.
John Paul Wallington <jpw@pobox.com>
parents: 48077
diff changeset
1514 file)
47355
9e3ee43b5262 (symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47305
diff changeset
1515 (while files
59124
f38536b30f3a (messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents: 58934
diff changeset
1516 (if (if type
f38536b30f3a (messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents: 58934
diff changeset
1517 (if (eq type 'defvar)
f38536b30f3a (messages-buffer-max-lines): Alias for message-log-max.
Richard M. Stallman <rms@gnu.org>
parents: 58934
diff changeset
1518 ;; 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
1519 (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
1520 ;; 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
1521 (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
1522 ;; 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
1523 ;; 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
1524 (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
1525 (rassq symbol (cdr (car files)))))
47355
9e3ee43b5262 (symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47305
diff changeset
1526 (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
1527 (setq files (cdr files)))
9e3ee43b5262 (symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47305
diff changeset
1528 file)))
39725
c64d3e3adf5d (symbol-file-load-history-loaded)
Miles Bader <miles@gnu.org>
parents: 39598
diff changeset
1529
66508
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1530 (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
1531 "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
1532 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
1533 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
1534 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
1535 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
1536 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
1537 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
1538 to the specified name LIBRARY.
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1539
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1540 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
1541 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
1542
95757
5be5ad6047d1 (locate-library): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 95366
diff changeset
1543 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
1544 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
1545 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
1546 (interactive (list (completing-read "Locate library: "
94183
bade431b9780 * finder.el (finder-commentary):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 94013
diff changeset
1547 (apply-partially
bade431b9780 * finder.el (finder-commentary):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 94013
diff changeset
1548 'locate-file-completion-table
bade431b9780 * finder.el (finder-commentary):
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 94013
diff changeset
1549 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
1550 nil nil
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1551 t))
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1552 (let ((file (locate-file library
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1553 (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
1554 (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
1555 load-file-rep-suffixes))))
66508
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1556 (if interactive-call
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1557 (if file
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1558 (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
1559 (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
1560 file))
ecdadc99bf8c * subr.el (locate-library): Move from help-fns.el.
Romain Francoise <romain@orebokech.com>
parents: 66315
diff changeset
1561
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
1562
66306
138f9b1d6682 (eval-at-startup): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 66304
diff changeset
1563 ;;;; Specifying things to do later.
138f9b1d6682 (eval-at-startup): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 66304
diff changeset
1564
70879
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1565 (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
1566 "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
1567 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
1568 (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
1569 (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
1570 (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
1571 (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
1572 (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
1573 ""
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1574 ;; 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
1575 ;; 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
1576 (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
1577 "\\(" (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
1578 "\\)?\\'"))
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1579
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1580 (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
1581 "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
1582 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
1583 (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
1584 (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
1585 (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
1586 (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
1587 (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
1588 (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
1589 (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
1590 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
1591 load-elt))
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1592
110034
c87f89486bb7 Use `declare' in defmacros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 110015
diff changeset
1593 (put 'eval-after-load 'lisp-indent-function 1)
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1594 (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
1595 "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
1596 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
1597
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1598 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
1599
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1600 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
1601 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
1602 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
1603 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
1604
71037
a0da1a83020d (load-history-regexp): If FILE is relative, insist
Richard M. Stallman <rms@gnu.org>
parents: 70903
diff changeset
1605 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
1606 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
1607 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
1608 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
1609
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1610 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
1611 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
1612 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
1613 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
1614
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1615 Alternatively, FILE can be a feature (i.e. a symbol), in which case FORM
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1616 is evaluated at the end of any file that `provide's this feature.
70879
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1617
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1618 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
1619 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
1620
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1621 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
1622 ;; 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
1623 ;; 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
1624 (let* ((regexp-or-feature
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1625 (if (stringp file)
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1626 (setq file (purecopy (load-history-regexp file)))
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1627 file))
70879
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1628 (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
1629 (unless elt
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1630 (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
1631 (push elt after-load-alist))
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1632 (when (symbolp regexp-or-feature)
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1633 ;; For features, the after-load-alist elements get run when `provide' is
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1634 ;; called rather than at the end of the file. So add an indirection to
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1635 ;; make sure that `form' is really run "after-load" in case the provide
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1636 ;; call happens early.
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1637 (setq form
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1638 `(when load-file-name
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1639 (let ((fun (make-symbol "eval-after-load-helper")))
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1640 (fset fun `(lambda (file)
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1641 (if (not (equal file ',load-file-name))
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1642 nil
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1643 (remove-hook 'after-load-functions ',fun)
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1644 ,',form)))
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1645 (add-hook 'after-load-functions fun)))))
70879
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1646 ;; 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
1647 (unless (member form (cdr elt))
105944
a465c7c7e59e * subr.el (add-hook): Purecopy strings.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105940
diff changeset
1648 (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
1649
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1650 ;; 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
1651 ;; matches FILE?
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1652 (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
1653 (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
1654 (featurep file))
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1655 (eval form))))
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1656
105027
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1657 (defvar after-load-functions nil
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1658 "Special hook run after loading a file.
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1659 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
1660 name of the file just loaded.")
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1661
70879
238e43ed886e startup.el (command-line): For names of preloaded files, don't append
Alan Mackenzie <acm@muc.de>
parents: 70678
diff changeset
1662 (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
1663 "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
1664 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
1665 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
1666 ;; 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
1667 (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
1668 (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
1669 (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
1670 ;; 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
1671 (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
1672 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
1673 ;; Complain when the user uses obsolete files.
105027
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1674 (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
1675 (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
1676 (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
1677 (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
1678 (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
1679 (string-match "\\.elc?\\>" file))))
105027
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1680 (file-name-nondirectory abs-file)))
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1681 ;; Finally, run any other hook.
8cbad31101f6 (after-load-functions): New hook.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104978
diff changeset
1682 (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
1683
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1684 (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
1685 "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
1686 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
1687 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
1688 (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
1689 (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
1690
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1691 ;;;; Process stuff.
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1692
86172
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1693 (defun process-lines (program &rest args)
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1694 "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
1695 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
1696 (with-temp-buffer
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1697 (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
1698 (unless (eq status 0)
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1699 (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
1700 (goto-char (point-min))
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1701 (let (lines)
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1702 (while (not (eobp))
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1703 (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
1704 (line-beginning-position)
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1705 (line-end-position))
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1706 lines))
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1707 (forward-line 1))
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1708 (nreverse lines)))))
e8cb5c919219 (process-lines): Move here from ../admin/admin.el.
Glenn Morris <rgm@gnu.org>
parents: 86152
diff changeset
1709
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
1710 ;; 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
1711
62372
4560134d21fa (open-network-stream-nowait): Remove.
Kim F. Storm <storm@cua.dk>
parents: 62326
diff changeset
1712 (when (featurep 'make-network-process)
4560134d21fa (open-network-stream-nowait): Remove.
Kim F. Storm <storm@cua.dk>
parents: 62326
diff changeset
1713 (defun open-network-stream (name buffer host service)
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1714 "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
1715 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
1716 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
1717
103485
40b49259dd71 Fix previous change, sigh.
Glenn Morris <rgm@gnu.org>
parents: 103484
diff changeset
1718 NAME is the name for the process. It is modified if necessary to make
40b49259dd71 Fix previous change, sigh.
Glenn Morris <rgm@gnu.org>
parents: 103484
diff changeset
1719 it unique.
103484
d0c5be11f069 (open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103107
diff changeset
1720 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
1721 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
1722 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
1723 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
1724 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
1725 a port number to connect to.
d0c5be11f069 (open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103107
diff changeset
1726
d0c5be11f069 (open-network-stream): Doc fix.
Glenn Morris <rgm@gnu.org>
parents: 103107
diff changeset
1727 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
1728 subset of its functionality."
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1729 (make-network-process :name name :buffer buffer
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1730 :host host :service service)))
45587
02df8e2ff88b (open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents: 45246
diff changeset
1731
02df8e2ff88b (open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents: 45246
diff changeset
1732 ;; compatibility
02df8e2ff88b (open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents: 45246
diff changeset
1733
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1734 (make-obsolete
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1735 'process-kill-without-query
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1736 "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
1737 "22.1")
45587
02df8e2ff88b (open-network-stream, open-network-stream-nowait)
Richard M. Stallman <rms@gnu.org>
parents: 45246
diff changeset
1738 (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
1739 "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
1740 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
1741 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
1742 (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
1743 (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
1744 old))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1745
103970
340cbf291f8a (process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents: 103884
diff changeset
1746 (defun process-kill-buffer-query-function ()
340cbf291f8a (process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents: 103884
diff changeset
1747 "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
1748 (let ((process (get-buffer-process (current-buffer))))
340cbf291f8a (process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents: 103884
diff changeset
1749 (or (not process)
340cbf291f8a (process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents: 103884
diff changeset
1750 (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
1751 (not (process-query-on-exit-flag process))
340cbf291f8a (process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents: 103884
diff changeset
1752 (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
1753
340cbf291f8a (process-kill-buffer-query-function): New function.
Juri Linkov <juri@jurta.org>
parents: 103884
diff changeset
1754 (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
1755
49225
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1756 ;; process plist management
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1757
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1758 (defun process-get (process propname)
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1759 "Return the value of PROCESS' PROPNAME property.
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1760 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
1761 (plist-get (process-plist process) propname))
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1762
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1763 (defun process-put (process propname value)
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1764 "Change PROCESS' PROPNAME property to VALUE.
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1765 It can be retrieved with `(process-get PROCESS PROPNAME)'."
49597
e88404e8f2cf Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49492
diff changeset
1766 (set-process-plist process
49225
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1767 (plist-put (process-plist process) propname value)))
50cb245b2072 (process-put, process-get): New functions.
Kim F. Storm <storm@cua.dk>
parents: 48935
diff changeset
1768
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1769
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1770 ;;;; Input and display facilities.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1771
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
1772 (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
1773 "*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
1774 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
1775
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
1776 (custom-declare-variable-early
47916
0bb8dc016c43 (remq): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 47747
diff changeset
1777 'read-quoted-char-radix 8
18880
1ed40ed8e0c1 (custom-declare-variable-early): New function.
Richard M. Stallman <rms@gnu.org>
parents: 18828
diff changeset
1778 "*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
1779 Legitimate radix values are 8, 10 and 16."
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1780 :type '(choice (const 8) (const 10) (const 16))
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
1781 :group 'editing-basics)
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
1782
104354
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
1783 (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
1784
105681
fac384c9a868 (read-key-delay): Reduce to 0.01.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105631
diff changeset
1785 (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
1786
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
1787 (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
1788 "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
1789 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
1790 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
1791 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
1792 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
1793 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
1794 (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
1795 (overriding-local-map nil)
109943
252e1eb2e944 * subr.el (read-key): Don't echo keystrokes.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109937
diff changeset
1796 (echo-keystrokes 0)
104354
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
1797 (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
1798 (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
1799 ;; 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
1800 ;; 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
1801 ;; 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
1802 ;; 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
1803 ;; 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
1804 ;; 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
1805 ;; "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
1806 ;; 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
1807 ;; 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
1808 ;; 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
1809 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
1810 (lambda ()
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
1811 (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
1812 (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
1813 ;; `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
1814 ;; 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
1815 ;; 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
1816 ;; 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
1817 ;; current input.
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
1818 (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
1819 (unwind-protect
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
1820 (progn
109937
9b8e40e0bf3c * lisp/subr.el (read-key): Don't hide the menu-bar entries.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109917
diff changeset
1821 (use-global-map
9b8e40e0bf3c * lisp/subr.el (read-key): Don't hide the menu-bar entries.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109917
diff changeset
1822 (let ((map (make-sparse-keymap)))
9b8e40e0bf3c * lisp/subr.el (read-key): Don't hide the menu-bar entries.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109917
diff changeset
1823 ;; Don't hide the menu-bar and tool-bar entries.
9b8e40e0bf3c * lisp/subr.el (read-key): Don't hide the menu-bar entries.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109917
diff changeset
1824 (define-key map [menu-bar] (lookup-key global-map [menu-bar]))
9b8e40e0bf3c * lisp/subr.el (read-key): Don't hide the menu-bar entries.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109917
diff changeset
1825 (define-key map [tool-bar] (lookup-key global-map [tool-bar]))
9b8e40e0bf3c * lisp/subr.el (read-key): Don't hide the menu-bar entries.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109917
diff changeset
1826 map))
105681
fac384c9a868 (read-key-delay): Reduce to 0.01.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105631
diff changeset
1827 (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
1828 (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
1829 (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
1830
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1831 (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
1832 "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
1833 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
1834 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
1835 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
1836 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
1837 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
1838
21008
7111f9cf9392 (read-quoted-char): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 20939
diff changeset
1839 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
1840 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
1841 for numeric input."
50427
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1842 (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
1843 (while (not done)
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
1844 (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
1845 ;; 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
1846 (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
1847 (help-form
f75e47f673f4 (read-quoted-char): Turn on help-form and turn off help-char.
Karl Heuer <kwzh@gnu.org>
parents: 12016
diff changeset
1848 "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
1849 or the octal character code.
18828
4837387f683c (read-quoted-char): Handle non-character events.
Richard M. Stallman <rms@gnu.org>
parents: 18821
diff changeset
1850 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
1851 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
1852 (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
1853 (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
1854 ;; 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
1855 ;; Note: `read-char' does it using the `ascii-character' property.
108661
0706b3de1aa0 Stefan Monnier <monnier@iro.umontreal.ca>
Chong Yidong <cyd@stupidchicken.com>
parents: 107684
diff changeset
1856 ;; We should try and use read-key instead.
0706b3de1aa0 Stefan Monnier <monnier@iro.umontreal.ca>
Chong Yidong <cyd@stupidchicken.com>
parents: 107684
diff changeset
1857 (let ((translation (lookup-key local-function-key-map (vector char))))
109242
b36e6aac8cf2 * lisp/subr.el (read-quoted-char): Fix up last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108675
diff changeset
1858 (setq translated (if (arrayp translation)
b36e6aac8cf2 * lisp/subr.el (read-quoted-char): Fix up last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108675
diff changeset
1859 (aref translation 0)
b36e6aac8cf2 * lisp/subr.el (read-quoted-char): Fix up last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108675
diff changeset
1860 char)))
b36e6aac8cf2 * lisp/subr.el (read-quoted-char): Fix up last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108675
diff changeset
1861 (if (integerp translated)
b36e6aac8cf2 * lisp/subr.el (read-quoted-char): Fix up last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 108675
diff changeset
1862 (setq translated (char-resolve-modifiers translated)))
50427
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1863 (cond ((null translated))
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1864 ((not (integerp translated))
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1865 (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
1866 done t))
50427
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1867 ((/= (logand translated ?\M-\^@) 0)
19175
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
1868 ;; 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
1869 (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
1870 done t))
105763
5041ae86859e (all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105681
diff changeset
1871 ((and (<= ?0 translated)
5041ae86859e (all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105681
diff changeset
1872 (< 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
1873 (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
1874 (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
1875 ((and (<= ?a (downcase translated))
105763
5041ae86859e (all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105681
diff changeset
1876 (< (downcase translated)
5041ae86859e (all-completions): Declare the 4th arg obsolete.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105681
diff changeset
1877 (+ ?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
1878 (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
1879 (+ 10 (- (downcase translated) ?a))))
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1880 (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
1881 ((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
1882 (setq done t))
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
1883 ((not first)
50427
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1884 (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
1885 done t))
50427
6ce9db7934cb (read-quoted-char): Remember the input char
Richard M. Stallman <rms@gnu.org>
parents: 50417
diff changeset
1886 (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
1887 done t)))
83425393d550 (read-quoted-char): Read any number of octal digits,
Richard M. Stallman <rms@gnu.org>
parents: 18044
diff changeset
1888 (setq first nil))
19175
3d80c899a15d (read-quoted-char): Fix handling of meta-chars.
Richard M. Stallman <rms@gnu.org>
parents: 19002
diff changeset
1889 code))
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
1890
57789
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1891 (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
1892 "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
1893 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
1894 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
1895
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1896 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
1897
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1898 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
1899 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
1900 C-g quits; if `inhibit-quit' was non-nil around this function,
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
1901 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
1902
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1903 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
1904 by doing (clear-string STRING)."
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1905 (with-local-quit
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1906 (if confirm
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1907 (let (success)
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1908 (while (not success)
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1909 (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
1910 (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
1911 (if (equal first second)
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1912 (progn
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1913 (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
1914 (setq success first))
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1915 (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
1916 (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
1917 (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
1918 (sit-for 1))))
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1919 success)
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1920 (let ((pass nil)
70897
b08d75867f7f (read-passwd): Copy PROMPT before changing its properties.
Richard M. Stallman <rms@gnu.org>
parents: 70879
diff changeset
1921 ;; 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
1922 ;; 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
1923 (prompt (copy-sequence prompt))
57789
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1924 (c 0)
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1925 (echo-keystrokes 0)
69978
cb54ae454387 (read-passwd): Bind `message-log-max' to nil.
Romain Francoise <romain@orebokech.com>
parents: 69830
diff changeset
1926 (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
1927 (message-log-max nil)
73ea1a22b6f4 (read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents: 99629
diff changeset
1928 (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
1929 (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
1930 (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
1931 minibuffer-prompt-properties prompt)
57789
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1932 (while (progn (message "%s%s"
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1933 prompt
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1934 (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
1935 (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
1936 (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
1937 (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
1938 (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
1939 (when (> (length pass) 0)
73ea1a22b6f4 (read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents: 99629
diff changeset
1940 (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
1941 (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
1942 (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
1943 ((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
1944 ((not (numberp c)))
73ea1a22b6f4 (read-passwd): Use read-event instead of read-char-exclusive.
Chong Yidong <cyd@stupidchicken.com>
parents: 99629
diff changeset
1945 ((= 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
1946 (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
1947 (setq pass ""))
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1948 ((= 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
1949 (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
1950 (current-kill 0)
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1951 (error nil)))
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1952 new-pass)
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1953 (when str
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1954 (setq new-pass
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1955 (concat pass
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1956 (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
1957 (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
1958 (setq c ?\0)
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1959 (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
1960 ((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
1961 (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
1962 (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
1963 (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
1964 (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
1965 (setq c ?\0)
a1ebcf06b544 (read-passwd): Yank current kill if the user enters C-y.
Chong Yidong <cyd@stupidchicken.com>
parents: 99365
diff changeset
1966 (setq pass new-pass)))))
57789
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1967 (message nil)
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1968 (or pass default "")))))
6a6fe71c779d subr.el (read-passwd): Move back from password.el.
Simon Josefsson <jas@extundo.com>
parents: 57778
diff changeset
1969
54570
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1970 ;; 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
1971 (defun read-number (prompt &optional default)
77359
d57bf0ca865e (read-number): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 77092
diff changeset
1972 "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
1973 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
1974 The value of DEFAULT is inserted into PROMPT."
54570
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1975 (let ((n nil))
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1976 (when default
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1977 (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
1978 (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
1979 (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
1980 (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
1981 (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
1982 prompt t t))))
54570
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1983 (while
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1984 (progn
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1985 (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
1986 (and default
f5cafaedbab0 (read-number): Check whether `default' is nil.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54887
diff changeset
1987 (number-to-string default)))))
77423
954d7a5a16f6 (read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents: 77359
diff changeset
1988 (condition-case nil
954d7a5a16f6 (read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents: 77359
diff changeset
1989 (setq n (cond
954d7a5a16f6 (read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents: 77359
diff changeset
1990 ((zerop (length str)) default)
954d7a5a16f6 (read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents: 77359
diff changeset
1991 ((stringp str) (read str))))
954d7a5a16f6 (read-number): Catch errors.
Richard M. Stallman <rms@gnu.org>
parents: 77359
diff changeset
1992 (error nil)))
54570
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1993 (unless (numberp n)
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1994 (message "Please enter a number.")
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1995 (sit-for 1)
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1996 t)))
cf58c77ee000 (read-number): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54016
diff changeset
1997 n))
71763
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
1998
112163
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
1999 (defun read-char-choice (prompt chars &optional inhibit-keyboard-quit)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2000 "Read and return one of CHARS, prompting for PROMPT.
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2001 Any input that is not one of CHARS is ignored.
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2002
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2003 If optional argument INHIBIT-KEYBOARD-QUIT is non-nil, ignore
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2004 keyboard-quit events while waiting for a valid input."
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2005 (unless (consp chars)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2006 (error "Called `read-char-choice' without valid char choices"))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2007 (let ((cursor-in-echo-area t)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2008 (executing-kbd-macro executing-kbd-macro)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2009 char done)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2010 (while (not done)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2011 (unless (get-text-property 0 'face prompt)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2012 (setq prompt (propertize prompt 'face 'minibuffer-prompt)))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2013 (setq char (let ((inhibit-quit inhibit-keyboard-quit))
112171
1c4c22434b0d * lisp/subr.el (read-char-choice): Use read-key. Suggested by Stefan.
Chong Yidong <cyd@stupidchicken.com>
parents: 112165
diff changeset
2014 (read-key prompt)))
112163
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2015 (cond
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2016 ((not (numberp char)))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2017 ((memq char chars)
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2018 (setq done t))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2019 ((and executing-kbd-macro (= char -1))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2020 ;; read-event returns -1 if we are in a kbd macro and
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2021 ;; there are no more events in the macro. Attempt to
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2022 ;; get an event interactively.
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2023 (setq executing-kbd-macro nil))))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2024 ;; Display the question with the answer.
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2025 (message "%s%s" prompt (char-to-string char))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2026 char))
b30a0deacfdf New function read-char-choice for reading a restricted set of chars.
Chong Yidong <cyd@stupidchicken.com>
parents: 112139
diff changeset
2027
71763
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
2028 (defun sit-for (seconds &optional nodisp obsolete)
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
2029 "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
2030 SECONDS may be a floating-point value.
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
2031 \(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
2032 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
2033
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
2034 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
2035 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
2036
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
2037 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
2038
71775
dbb73e0b716b (sit-for): Doc fix. Specify normal arg list using fn-form.
Kim F. Storm <storm@cua.dk>
parents: 71763
diff changeset
2039 An obsolete, but still supported form is
71763
bedc73f663be * subr.el (sit-for): New function.
Chong Yidong <cyd@stupidchicken.com>
parents: 71726
diff changeset
2040 \(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
2041 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
2042 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
2043 floating point support."
80173
0fade0cf2913 (sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents: 80023
diff changeset
2044 (if (numberp nodisp)
0fade0cf2913 (sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents: 80023
diff changeset
2045 (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
2046 nodisp obsolete)
0fade0cf2913 (sit-for): Fix obsolete form for nil second argument.
Glenn Morris <rgm@gnu.org>
parents: 80023
diff changeset
2047 (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
2048 (cond
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2049 (noninteractive
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2050 (sleep-for seconds)
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2051 t)
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2052 ((input-pending-p)
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2053 nil)
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2054 ((<= seconds 0)
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2055 (or nodisp (redisplay)))
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2056 (t
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2057 (or nodisp (redisplay))
b70548506872 (sit-for): Rework to use input-pending-p and cond.
Kim F. Storm <storm@cua.dk>
parents: 72784
diff changeset
2058 (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
2059 (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
2060 (progn
03050ee24abc (add-to-list): Optimize if compare-fn is `eq' or `eql'.
Kim F. Storm <storm@cua.dk>
parents: 73415
diff changeset
2061 ;; 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
2062 ;; 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
2063 ;; 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
2064 (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
2065 (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
2066 (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
2067 nil))))))
110356
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
2068 (set-advertised-calling-convention 'sit-for '(seconds &optional nodisp) "22.1")
112139
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2069
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2070 (defun y-or-n-p (prompt &rest args)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2071 "Ask user a \"y or n\" question. Return t if answer is \"y\".
112165
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112163
diff changeset
2072 The string to display to ask the question is obtained by
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112163
diff changeset
2073 formatting the string PROMPT with arguments ARGS (see `format').
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112163
diff changeset
2074 The result should end in a space; `y-or-n-p' adds \"(y or n) \"
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112163
diff changeset
2075 to it.
fd05a6b39a42 Doc fix for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 112163
diff changeset
2076
112139
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2077 No confirmation of the answer is requested; a single character is enough.
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2078 Also accepts Space to mean yes, or Delete to mean no. \(Actually, it uses
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2079 the bindings in `query-replace-map'; see the documentation of that variable
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2080 for more information. In this case, the useful bindings are `act', `skip',
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2081 `recenter', and `quit'.\)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2082
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2083 Under a windowing system a dialog box will be used if `last-nonmenu-event'
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2084 is nil and `use-dialog-box' is non-nil."
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2085 ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2086 ;; where all the keys were unbound (i.e. it somehow got triggered
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2087 ;; within read-key, apparently). I had to kill it.
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2088 (let ((answer 'recenter))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2089 (if (and (display-popup-menus-p)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2090 (listp last-nonmenu-event)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2091 use-dialog-box)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2092 (setq answer
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2093 (x-popup-dialog t `(,prompt ("yes" . act) ("No" . skip))))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2094 (setq prompt (concat (apply 'format prompt args)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2095 (if (eq ?\s (aref prompt (1- (length prompt))))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2096 "" " ")
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2097 "(y or n) "))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2098 (while
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2099 (let* ((key
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2100 (let ((cursor-in-echo-area t))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2101 (when minibuffer-auto-raise
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2102 (raise-frame (window-frame (minibuffer-window))))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2103 (read-key (propertize (if (eq answer 'recenter)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2104 prompt
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2105 (concat "Please answer y or n. "
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2106 prompt))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2107 'face 'minibuffer-prompt)))))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2108 (setq answer (lookup-key query-replace-map (vector key) t))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2109 (cond
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2110 ((memq answer '(skip act)) nil)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2111 ((eq answer 'recenter) (recenter) t)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2112 ((memq answer '(exit-prefix quit)) (signal 'quit nil) t)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2113 (t t)))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2114 (ding)
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2115 (discard-input)))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2116 (let ((ret (eq answer 'act)))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2117 (unless noninteractive
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2118 (message "%s %s" prompt (if ret "y" "n")))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2119 ret)))
8d03223bf479 Allow format args for y-or-n-p and yes-or-no-p.
Chong Yidong <cyd@stupidchicken.com>
parents: 111971
diff changeset
2120
20472
79ea90039b23 (read-password): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20410
diff changeset
2121
44668
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2122 ;;; Atomic change groups.
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2123
43126
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2124 (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
2125 "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
2126 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
2127 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
2128 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
2129
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2130 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
2131 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
2132 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
2133 (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
2134 (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
2135 (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
2136 `(let ((,handle (prepare-change-group))
79824
e9adfbf7d96e (atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents: 79721
diff changeset
2137 ;; 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
2138 (undo-outer-limit nil)
e9adfbf7d96e (atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents: 79721
diff changeset
2139 (undo-limit most-positive-fixnum)
e9adfbf7d96e (atomic-change-group): Prevent undo list truncation.
Richard M. Stallman <rms@gnu.org>
parents: 79721
diff changeset
2140 (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
2141 (,success nil))
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2142 (unwind-protect
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2143 (progn
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2144 ;; 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
2145 ;; 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
2146 ;; 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
2147 (activate-change-group ,handle)
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2148 ,@body
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2149 (setq ,success t))
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2150 ;; 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
2151 ;; 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
2152 (if ,success
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2153 (accept-change-group ,handle)
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2154 (cancel-change-group ,handle))))))
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2155
51068
4441e202a6f4 (prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents: 51062
diff changeset
2156 (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
2157 "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
2158 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
2159
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2160 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
2161 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
2162
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2163 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
2164 `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
2165 `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
2166 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
2167 `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
2168 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
2169 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
2170 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
2171 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
2172
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2173 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
2174 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
2175 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
2176
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2177 (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
2178 (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
2179
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2180 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
2181 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
2182 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
2183
51068
4441e202a6f4 (prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents: 51062
diff changeset
2184 (if buffer
4441e202a6f4 (prepare-change-group): Reinstate BUFFER arg; make it work.
Richard M. Stallman <rms@gnu.org>
parents: 51062
diff changeset
2185 (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
2186 (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
2187
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2188 (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
2189 "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
2190 (dolist (elt handle)
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2191 (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
2192 (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
2193 (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
2194
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2195 (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
2196 "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
2197 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
2198 (dolist (elt handle)
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2199 (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
2200 (if (eq elt t)
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2201 (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
2202
6f39ff1c6d8f (atomic-change-group, prepare-change-group, activate-change-group)
Richard M. Stallman <rms@gnu.org>
parents: 42941
diff changeset
2203 (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
2204 "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
2205 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
2206 (dolist (elt handle)
ac327929a12c (cancel-change-group): Improve last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 80022
diff changeset
2207 (with-current-buffer (car elt)
ac327929a12c (cancel-change-group): Improve last fix.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 80022
diff changeset
2208 (setq elt (cdr elt))
98071
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2209 (save-restriction
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2210 ;; 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
2211 ;; 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
2212 (widen)
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2213 (let ((old-car
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2214 (if (consp elt) (car elt)))
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2215 (old-cdr
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2216 (if (consp elt) (cdr elt))))
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2217 ;; Temporarily truncate the undo log at ELT.
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2218 (when (consp elt)
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2219 (setcar elt nil) (setcdr elt nil))
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2220 (unless (eq last-command 'undo) (undo-start))
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2221 ;; Make sure there's no confusion.
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2222 (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
2223 (error "Undoing to some unrelated state"))
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2224 ;; Undo it all.
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2225 (save-excursion
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2226 (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
2227 ;; 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
2228 (when (consp elt)
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2229 (setcar elt old-car)
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2230 (setcdr elt old-cdr))
c94db6d7eda9 (cancel-change-group): Widen buffer temporarily when
Martin Rudalics <rudalics@gmx.at>
parents: 98026
diff changeset
2231 ;; 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
2232 (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
2233
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2234 ;;;; 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
2235
44285
30505fab0350 (redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents: 44251
diff changeset
2236 ;; For compatibility.
30505fab0350 (redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents: 44251
diff changeset
2237 (defalias 'redraw-modeline 'force-mode-line-update)
30505fab0350 (redraw-modeline): Define alias.
Richard M. Stallman <rms@gnu.org>
parents: 44251
diff changeset
2238
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
2239 (defun force-mode-line-update (&optional all)
52858
b4112065d679 (force-mode-line-update): Fix docstring.
Lute Kamstra <lute@gnu.org>
parents: 52401
diff changeset
2240 "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
2241 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
2242 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
2243 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
2244 (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
2245 (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
2246
41618
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2247 (defun momentary-string-display (string pos &optional exit-char message)
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2248 "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
2249 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
2250 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
2251 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
2252 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
2253 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
2254 input (as a command if nothing else).
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2255 Display MESSAGE (optional fourth arg) in the echo area.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2256 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
2257 (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
2258 (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
2259 (str (copy-sequence string)))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2260 (unwind-protect
95778
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2261 (progn
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2262 (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
2263 (overlay-put ol 'after-string str)
95778
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2264 (goto-char pos)
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2265 ;; 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
2266 (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
2267 ;; 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
2268 (if (<= (window-end nil t) pos)
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2269 (recenter (/ (window-height) 2))))
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2270 (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
2271 (single-key-description exit-char))
108675
e3df298f4131 Fix for momentary-string-display (Bug#6238).
Chong Yidong <cyd@stupidchicken.com>
parents: 108661
diff changeset
2272 (let ((event (read-event)))
e3df298f4131 Fix for momentary-string-display (Bug#6238).
Chong Yidong <cyd@stupidchicken.com>
parents: 108661
diff changeset
2273 ;; `exit-char' can be an event, or an event description list.
e3df298f4131 Fix for momentary-string-display (Bug#6238).
Chong Yidong <cyd@stupidchicken.com>
parents: 108661
diff changeset
2274 (or (eq event exit-char)
e3df298f4131 Fix for momentary-string-display (Bug#6238).
Chong Yidong <cyd@stupidchicken.com>
parents: 108661
diff changeset
2275 (eq event (event-convert-list exit-char))
e3df298f4131 Fix for momentary-string-display (Bug#6238).
Chong Yidong <cyd@stupidchicken.com>
parents: 108661
diff changeset
2276 (setq unread-command-events (list event)))))
95778
c9b3cb8a81ec (momentary-string-display): Use an overlay.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 95757
diff changeset
2277 (delete-overlay ol))))
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2278
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
2279
41618
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2280 ;;;; Overlay operations
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2281
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2282 (defun copy-overlay (o)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2283 "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
2284 (let ((o1 (if (overlay-buffer o)
6429fc34756a * subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 106815
diff changeset
2285 (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
2286 ;; 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
2287 ;; insertion-type of the two markers.
6429fc34756a * subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 106815
diff changeset
2288 (overlay-buffer o))
6429fc34756a * subr.el (copy-overlay): Handle deleted overlays.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 106815
diff changeset
2289 (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
2290 (delete-overlay o1)
107133
a0d4034e4be0 (copy-overlay): Damn typo.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 107132
diff changeset
2291 o1)))
41618
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2292 (props (overlay-properties o)))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2293 (while props
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2294 (overlay-put o1 (pop props) (pop props)))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2295 o1))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2296
55202
4c64ee838f41 * subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents: 55187
diff changeset
2297 (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
2298 "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
2299 Overlays might be moved and/or split.
e191e6d1554e (remove-overlays, read-passwd): Fix docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55406
diff changeset
2300 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
2301 ;; 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
2302 (unless beg (setq beg (point-min)))
4c64ee838f41 * subr.el (remove-overlays): Make arguments optional.
Masatake YAMATO <jet@gyve.org>
parents: 55187
diff changeset
2303 (unless end (setq end (point-max)))
73943
882d43d66c71 (remove-overlays): Fix last change.
Richard M. Stallman <rms@gnu.org>
parents: 73831
diff changeset
2304 (overlay-recenter end)
41618
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2305 (if (< end beg)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2306 (setq beg (prog1 end (setq end beg))))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2307 (save-excursion
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2308 (dolist (o (overlays-in beg end))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2309 (when (eq (overlay-get o name) val)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2310 ;; Either push this overlay outside beg...end
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2311 ;; or split it to exclude beg...end
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2312 ;; 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
2313 (if (< (overlay-start o) beg)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2314 (if (> (overlay-end o) end)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2315 (progn
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2316 (move-overlay (copy-overlay o)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2317 (overlay-start o) beg)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2318 (move-overlay o end (overlay-end o)))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2319 (move-overlay o (overlay-start o) beg))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2320 (if (> (overlay-end o) end)
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2321 (move-overlay o end (overlay-end o))
812e52cc5162 (copy-overlay, remove-overlays): New funs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 41187
diff changeset
2322 (delete-overlay o)))))))
42917
ec2db12c7670 (copy-without-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 42266
diff changeset
2323
2504
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
2324 ;;;; Miscellanea.
181eef669324 * subr.el (overlay-start, overlay-end, overlay-buffer): New
Jim Blandy <jimb@redhat.com>
parents: 2428
diff changeset
2325
20846
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
2326 (defvar suspend-hook nil
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
2327 "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
2328
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
2329 (defvar suspend-resume-hook nil
985a277c9b9a (suspend-hook, suspend-resume-hook): New defvars.
Richard M. Stallman <rms@gnu.org>
parents: 20687
diff changeset
2330 "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
2331
42083
981f93cc55d1 (temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents: 42076
diff changeset
2332 (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
2333 "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
2334 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
2335 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
2336
981f93cc55d1 (temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents: 42076
diff changeset
2337 (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
2338 "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
2339 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
2340 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
2341 mode.")
981f93cc55d1 (temp-buffer-show-hook, temp-buffer-setup-hook): Add defvars.
Richard M. Stallman <rms@gnu.org>
parents: 42076
diff changeset
2342
10254
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
2343 ;; Avoid compiler warnings about this variable,
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
2344 ;; 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
2345 (defvar buffer-file-type nil
1ac3c8fea14a (font-lock-defaults): Add defvar.
Richard M. Stallman <rms@gnu.org>
parents: 10178
diff changeset
2346 "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
2347 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
2348 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
2349 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
2350
f4d24a8eaed1 (toplevel): Define `cl-assertion-failed' condition here because the
John Paul Wallington <jpw@pobox.com>
parents: 68400
diff changeset
2351 ;; 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
2352 ;; `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
2353 (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
2354 (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
2355
81338
62535fec6ee1 (user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents: 77423
diff changeset
2356 (defconst user-emacs-directory
62535fec6ee1 (user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents: 77423
diff changeset
2357 (if (eq system-type 'ms-dos)
62535fec6ee1 (user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents: 77423
diff changeset
2358 ;; MS-DOS cannot have initial dot.
62535fec6ee1 (user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents: 77423
diff changeset
2359 "~/_emacs.d/"
62535fec6ee1 (user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents: 77423
diff changeset
2360 "~/.emacs.d/")
62535fec6ee1 (user-emacs-directory): New defconst.
Chong Yidong <cyd@stupidchicken.com>
parents: 77423
diff changeset
2361 "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
2362 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
2363 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
2364 See also `locate-user-emacs-file'.")
814d2d823dd7 New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents: 98949
diff changeset
2365
814d2d823dd7 New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents: 98949
diff changeset
2366 (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
2367 "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
2368 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
2369 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
2370 directory if it does not exist."
814d2d823dd7 New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents: 98949
diff changeset
2371 (convert-standard-filename
814d2d823dd7 New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents: 98949
diff changeset
2372 (let* ((home (concat "~" (or init-file-user "")))
814d2d823dd7 New function `locate-user-emacs-file'.
Juanma Barranquero <lekktu@gmail.com>
parents: 98949
diff changeset
2373 (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
2374 (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
2375 at-home
99184
fc215de0bf93 * subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents: 99124
diff changeset
2376 ;; 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
2377 ;; 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
2378 (or noninteractive
fc215de0bf93 * subr.el (locate-user-emacs-file): Simplify. Don't create
Juanma Barranquero <lekktu@gmail.com>
parents: 99124
diff changeset
2379 purify-flag
112266
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2380 (file-accessible-directory-p
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2381 (directory-file-name user-emacs-directory))
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2382 (let ((umask (default-file-modes)))
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2383 (unwind-protect
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2384 (progn
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2385 (set-default-file-modes ?\700)
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2386 (make-directory user-emacs-directory))
704fa1a3d5b4 Make last-resort backup file in .emacs.d (Bug#6953).
Chong Yidong <cyd@stupidchicken.com>
parents: 112262
diff changeset
2387 (set-default-file-modes umask))))
104354
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
2388 (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
2389 (expand-file-name new-name user-emacs-directory))))))
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2390
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2391 ;;;; 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
2392
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2393 (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
2394 "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
2395 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
2396 (let (from to bound)
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2397 (when (or (progn
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2398 ;; Look at text around `point'.
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2399 (save-excursion
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2400 (skip-syntax-backward "w_") (setq from (point)))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2401 (save-excursion
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2402 (skip-syntax-forward "w_") (setq to (point)))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2403 (> to from))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2404 ;; Look between `line-beginning-position' and `point'.
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2405 (save-excursion
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2406 (and (setq bound (line-beginning-position))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2407 (skip-syntax-backward "^w_" bound)
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2408 (> (setq to (point)) bound)
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2409 (skip-syntax-backward "w_")
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2410 (setq from (point))))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2411 ;; Look between `point' and `line-end-position'.
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2412 (save-excursion
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2413 (and (setq bound (line-end-position))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2414 (skip-syntax-forward "^w_" bound)
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2415 (< (setq from (point)) bound)
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2416 (skip-syntax-forward "w_")
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2417 (setq to (point)))))
6cd236e3935c (find-tag-default): Simplify using exclusively
Martin Rudalics <rudalics@gmx.at>
parents: 87974
diff changeset
2418 (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
2419
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2420 (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
2421 "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
2422 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
2423
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2424 :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
2425 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
2426
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2427 :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
2428
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2429 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
2430
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2431 :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
2432 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
2433 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
2434
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2435 :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
2436 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
2437
1df37db69e4d * subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents: 101082
diff changeset
2438 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
2439 (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
2440 (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
2441 (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
2442
86221
d6b46513e321 (w32-shell-dos-semantics): Declare as function.
Glenn Morris <rgm@gnu.org>
parents: 86172
diff changeset
2443 (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
2444
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2445 (defun shell-quote-argument (argument)
101142
1df37db69e4d * subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents: 101082
diff changeset
2446 "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
2447 (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
2448 (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
2449 ;; 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
2450 ;; 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
2451 (let ((result "")
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2452 (start 0)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2453 end)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2454 (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
2455 (< (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
2456 (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
2457 (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
2458 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
2459 "\\" (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
2460 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
2461 (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
2462 (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
2463 "''"
c637565b16e8 (shell-quote-argument): Use DOS logic for Windows shells with DOS semantics.
Jason Rumney <jasonr@gnu.org>
parents: 73028
diff changeset
2464 ;; 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
2465 ;; 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
2466 (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
2467 (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
2468 (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
2469 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
2470 "\\" (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
2471 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
2472 (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
2473
196122ba0b05 * subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents: 69168
diff changeset
2474 (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
2475 "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
2476 Otherwise, return nil."
196122ba0b05 * subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents: 69168
diff changeset
2477 (or (stringp object) (null object)))
196122ba0b05 * subr.el (string-or-null-p): New function.
Reiner Steib <Reiner.Steib@gmx.de>
parents: 69168
diff changeset
2478
70267
a2c45c9f7e1f (booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 70229
diff changeset
2479 (defun booleanp (object)
110710
deee083d1b01 * subr.el (booleanp): Return t instead of a list (Bug#7086).
Chong Yidong <cyd@stupidchicken.com>
parents: 110695
diff changeset
2480 "Return t if OBJECT is one of the two canonical boolean values: t or nil.
deee083d1b01 * subr.el (booleanp): Return t instead of a list (Bug#7086).
Chong Yidong <cyd@stupidchicken.com>
parents: 110695
diff changeset
2481 Otherwise, return nil."
deee083d1b01 * subr.el (booleanp): Return t instead of a list (Bug#7086).
Chong Yidong <cyd@stupidchicken.com>
parents: 110695
diff changeset
2482 (and (memq object '(nil t)) t))
70267
a2c45c9f7e1f (booleanp): New fun.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 70229
diff changeset
2483
70552
1121231ccc23 Revision: emacs@sv.gnu.org/emacs--devo--0--patch-271
Miles Bader <miles@gnu.org>
parents: 70547
diff changeset
2484 (defun field-at-pos (pos)
101142
1df37db69e4d * subr.el (play-sound): Doc fix. (Bug#250)
Juanma Barranquero <lekktu@gmail.com>
parents: 101082
diff changeset
2485 "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
2486 (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
2487 (if (eq raw-field 'boundary)
e184fae4f7dd (field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents: 70512
diff changeset
2488 (get-char-property (1- (field-end pos)) 'field)
e184fae4f7dd (field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents: 70512
diff changeset
2489 raw-field)))
e184fae4f7dd (field-at-point): New function.
Nick Roberts <nickrob@snap.net.nz>
parents: 70512
diff changeset
2490
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2491
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2492 ;;;; 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
2493
44668
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2494 (defvar yank-excluded-properties)
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2495
44980
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2496 (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
2497 "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
2498 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
2499 (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
2500 ;; 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
2501 ;; 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
2502 ;; 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
2503 ;; 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
2504 ;; for the details.
44980
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2505 (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
2506 (save-excursion
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2507 (goto-char start)
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2508 (while (< (point) end)
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2509 (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
2510 run-end)
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2511 (setq run-end
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2512 (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
2513 (when cat
cb548fe4bcdb (remove-yank-excluded-properties): Fix bugs in handling of category properties.
Richard M. Stallman <rms@gnu.org>
parents: 47652
diff changeset
2514 (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
2515 (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
2516 (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
2517 (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
2518 (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
2519 (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
2520 (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
2521 (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
2522 (goto-char run-end)))))
44980
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2523 (if (eq yank-excluded-properties t)
5eb4aa56b278 (remove-yank-excluded-properties): New helper function.
Kim F. Storm <storm@cua.dk>
parents: 44945
diff changeset
2524 (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
2525 (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
2526
49310
32fe2d888907 (insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents: 49225
diff changeset
2527 (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
2528
32fe2d888907 (insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents: 49225
diff changeset
2529 (defun insert-for-yank (string)
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
2530 "Call `insert-for-yank-1' repetitively for each `yank-handler' segment.
53368
6dab9150c9e0 (insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53197
diff changeset
2531
6dab9150c9e0 (insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53197
diff changeset
2532 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
2533 (let (to)
6dab9150c9e0 (insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53197
diff changeset
2534 (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
2535 (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
2536 (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
2537 (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
2538
6dab9150c9e0 (insert-for-yank): Call insert-for-yank-1 repetitively
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53197
diff changeset
2539 (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
2540 "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
2541
49310
32fe2d888907 (insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents: 49225
diff changeset
2542 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
2543 `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
2544
49363
7bf92531d421 Tiny doc fixes.
Kim F. Storm <storm@cua.dk>
parents: 49318
diff changeset
2545 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
2546 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
2547 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
2548 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
2549 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
2550 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
2551 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
2552 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
2553 `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
2554 rectangle.
32fe2d888907 (insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents: 49225
diff changeset
2555 If NOEXCLUDE is present and non-nil, the normal removal of the
111936
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
2556 `yank-excluded-properties' is not performed; instead FUNCTION is
49310
32fe2d888907 (insert-for-yank): Arg list changed; now only accepts one
Kim F. Storm <storm@cua.dk>
parents: 49225
diff changeset
2557 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
2558 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
2559 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
2560 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
2561 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
2562 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
2563 (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
2564 (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
2565 (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
2566 (opoint (point))
75748
8c99ad9fd6c0 (insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents: 75347
diff changeset
2567 (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
2568 end)
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2569
49318
63a122cc4286 (insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents: 49313
diff changeset
2570 (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
2571 (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
2572 (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
2573 (insert param))
73153
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2574 (setq end (point))
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2575
75748
8c99ad9fd6c0 (insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents: 75347
diff changeset
2576 ;; 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
2577 ;; following text property changes.
8c99ad9fd6c0 (insert-for-yank-1): Prevent read-only properties from interfering
Chong Yidong <cyd@stupidchicken.com>
parents: 75347
diff changeset
2578 (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
2579
73153
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2580 ;; 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
2581 (if font-lock-defaults
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2582 ;; No, just wipe them.
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2583 (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
2584 ;; Convert them to `face'.
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2585 (save-excursion
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2586 (goto-char opoint)
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2587 (while (< (point) end)
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2588 (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
2589 run-end)
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2590 (setq run-end
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2591 (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
2592 (when face
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2593 (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
2594 (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
2595 (goto-char run-end)))))
d18b30d3454b (insert-for-yank-1): Handle `font-lock-face' specially.
Richard M. Stallman <rms@gnu.org>
parents: 73125
diff changeset
2596
49318
63a122cc4286 (insert-for-yank): Set yank-undo-function after calling FUNCTION,
Kim F. Storm <storm@cua.dk>
parents: 49313
diff changeset
2597 (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
2598 (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
2599
56ea5a847db0 (insert-for-yank-1): If last inserted char has properties,
Richard M. Stallman <rms@gnu.org>
parents: 73357
diff changeset
2600 ;; 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
2601 (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
2602 (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
2603 (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
2604
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
2605 (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
2606 (setq yank-undo-function (nth 3 handler))) ;; UNDO
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
2607 (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
2608 (setq this-command (nth 4 handler)))))
49597
e88404e8f2cf Trailing whitespace deleted.
Juanma Barranquero <lekktu@gmail.com>
parents: 49492
diff changeset
2609
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
2610 (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
2611 "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
2612 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
2613 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
2614 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
2615 (let ((opoint (point)))
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
2616 (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
2617 (let ((inhibit-read-only t))
f5b7b7055a64 (insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents: 44668
diff changeset
2618 (set-text-properties opoint (point) nil))))
f5b7b7055a64 (insert-buffer-substring-no-properties): New function.
Kim F. Storm <storm@cua.dk>
parents: 44668
diff changeset
2619
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
2620 (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
2621 "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
2622 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
2623 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
2624 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
2625 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
2626 `yank-excluded-properties'."
52379
541533296a1d Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 52132
diff changeset
2627 ;; Since the buffer text should not normally have yank-handler properties,
541533296a1d Comment change.
Richard M. Stallman <rms@gnu.org>
parents: 52132
diff changeset
2628 ;; 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
2629 (let ((opoint (point)))
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
2630 (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
2631 (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
2632
44668
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2633
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2634 ;;;; Synchronous shell commands.
44668
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2635
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2636 (defun start-process-shell-command (name buffer &rest args)
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2637 "Start a program in a subprocess. Return the process object for it.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2638 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
2639 BUFFER is the buffer (or buffer name) to associate with the process.
114
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2640 Process output goes at end of that buffer, unless you specify
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2641 an output stream or filter function to handle the output.
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2642 BUFFER may be also nil, meaning that this process is not associated
899728e6052a Initial revision
David Lawrence <tale@gnu.org>
parents:
diff changeset
2643 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
2644 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
2645
7d0f4f179b3d * subr.el (listify-key-sequence-1): Use normal syntax since those
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104215
diff changeset
2646 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
2647 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
2648 discouraged."
10025
3b058e13d177 (start-process-shell-command): Don't use `exec'--
Richard M. Stallman <rms@gnu.org>
parents: 9986
diff changeset
2649 ;; 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
2650 ;; but that failed to handle (...) and semicolon, etc.
97142
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2651 (start-process name buffer shell-file-name shell-command-switch
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2652 (mapconcat 'identity args " ")))
105631
7cea65998c1f * subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents: 105629
diff changeset
2653 (set-advertised-calling-convention 'start-process-shell-command
110356
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
2654 '(name buffer command) "23.1")
105631
7cea65998c1f * subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents: 105629
diff changeset
2655
82094
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2656 (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
2657 "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
2658 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
2659 (start-file-process
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2660 name buffer
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2661 (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
2662 (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
2663 (mapconcat 'identity args " ")))
105631
7cea65998c1f * subr.el (error, sit-for, start-process-shell-command)
Juanma Barranquero <lekktu@gmail.com>
parents: 105629
diff changeset
2664 (set-advertised-calling-convention 'start-file-process-shell-command
110356
d2f5496377e6 * subr.el (unintern): Declare the obarray arg mandatory.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 109943
diff changeset
2665 '(name buffer command) "23.1")
82094
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2666
39598
67884544e4c8 (call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents: 39557
diff changeset
2667 (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
2668 &rest args)
67884544e4c8 (call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents: 39557
diff changeset
2669 "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
2670 The remaining arguments are optional.
67884544e4c8 (call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents: 39557
diff changeset
2671 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
2672 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
2673 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
2674 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
2675 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
2676 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
2677 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
2678 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
2679
67884544e4c8 (call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents: 39557
diff changeset
2680 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
2681 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
2682 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
2683
67884544e4c8 (call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents: 39557
diff changeset
2684 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
2685 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
2686 status or a signal description string.
67884544e4c8 (call-process-shell-command): New function.
Miles Bader <miles@gnu.org>
parents: 39557
diff changeset
2687 If you quit, the process is killed with SIGINT, or SIGKILL if you quit again."
97142
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2688 ;; We used to use `exec' to replace the shell with the command,
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2689 ;; but that failed to handle (...) and semicolon, etc.
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2690 (call-process shell-file-name
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2691 infile buffer display
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2692 shell-command-switch
c3512b2085a0 * bitmaps/README:
Dan Nicolaescu <dann@ics.uci.edu>
parents: 96361
diff changeset
2693 (mapconcat 'identity (cons command args) " ")))
82094
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2694
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2695 (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
2696 &rest args)
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2697 "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
2698 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
2699 (process-file
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2700 (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
2701 infile buffer display
76546b143f2d * subr.el (start-file-process-shell-command)
Michael Albinus <michael.albinus@gmx.de>
parents: 81863
diff changeset
2702 (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
2703 (mapconcat 'identity (cons command args) " ")))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
2704
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2705 ;;;; 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
2706
99124
a96e658622b6 (with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents: 99106
diff changeset
2707 (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
2708 "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
2709 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
2710 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
2711 also `with-temp-buffer'."
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2712 (declare (indent 1) (debug t))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2713 `(save-current-buffer
99124
a96e658622b6 (with-current-buffer): Rename buffer argument to buffer-or-name.
Martin Rudalics <rudalics@gmx.at>
parents: 99106
diff changeset
2714 (set-buffer ,buffer-or-name)
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2715 ,@body))
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2716
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2717 (defmacro with-selected-window (window &rest body)
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2718 "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
2719 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
2720
99327
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2721 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
2722 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
2723 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
2724 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
2725 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
2726 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
2727 remains selected.
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2728
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2729 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
2730 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
2731 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
2732 the buffer list ordering."
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2733 (declare (indent 1) (debug t))
55828
af9432138635 (with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 55812
diff changeset
2734 ;; 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
2735 `(let ((save-selected-window-window (selected-window))
af9432138635 (with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 55812
diff changeset
2736 ;; 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
2737 ;; 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
2738 ;; frame that window is in.
af9432138635 (with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 55812
diff changeset
2739 (save-selected-window-alist
af9432138635 (with-selected-window): Undo previous change.
Richard M. Stallman <rms@gnu.org>
parents: 55812
diff changeset
2740 (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
2741 (frame-list))))
63761
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2742 (save-current-buffer
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2743 (unwind-protect
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2744 (progn (select-window ,window 'norecord)
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2745 ,@body)
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2746 (dolist (elt save-selected-window-alist)
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2747 (and (frame-live-p (car elt))
f14d5e7e60e1 (with-selected-window): Use save-current-buffer.
Richard M. Stallman <rms@gnu.org>
parents: 63664
diff changeset
2748 (window-live-p (cadr elt))
99327
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2749 (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
2750 (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
2751 (select-window save-selected-window-window 'norecord))))))
16277
bbddbc86b82b (with-current-buffer): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 15983
diff changeset
2752
83128
2ccd88cfde01 New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 55520
diff changeset
2753 (defmacro with-selected-frame (frame &rest body)
2ccd88cfde01 New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 55520
diff changeset
2754 "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
2755 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
2756
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2757 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
2758 nor the buffer list."
83128
2ccd88cfde01 New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 55520
diff changeset
2759 (declare (indent 1) (debug t))
83488
f47495b26508 Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83483
diff changeset
2760 (let ((old-frame (make-symbol "old-frame"))
f47495b26508 Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83483
diff changeset
2761 (old-buffer (make-symbol "old-buffer")))
f47495b26508 Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83483
diff changeset
2762 `(let ((,old-frame (selected-frame))
f47495b26508 Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83483
diff changeset
2763 (,old-buffer (current-buffer)))
f47495b26508 Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83483
diff changeset
2764 (unwind-protect
99327
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2765 (progn (select-frame ,frame 'norecord)
83488
f47495b26508 Fix ediff problems. (Reported by Dan Nicolaescu.)
Karoly Lorentey <lorentey@elte.hu>
parents: 83483
diff changeset
2766 ,@body)
99327
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2767 (when (frame-live-p ,old-frame)
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2768 (select-frame ,old-frame 'norecord))
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2769 (when (buffer-live-p ,old-buffer)
d646820f5ba2 (with-selected-window): Call set-frame-selected-window
Martin Rudalics <rudalics@gmx.at>
parents: 99184
diff changeset
2770 (set-buffer ,old-buffer))))))
83128
2ccd88cfde01 New control structure: with-selected-frame.
Karoly Lorentey <lorentey@elte.hu>
parents: 55520
diff changeset
2771
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2772 (defmacro with-temp-file (file &rest body)
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2773 "Create a new buffer, evaluate BODY there, and write the buffer to FILE.
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2774 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
2775 See also `with-temp-buffer'."
110034
c87f89486bb7 Use `declare' in defmacros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 110015
diff changeset
2776 (declare (indent 1) (debug t))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
2777 (let ((temp-file (make-symbol "temp-file"))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2778 (temp-buffer (make-symbol "temp-buffer")))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2779 `(let ((,temp-file ,file)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2780 (,temp-buffer
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2781 (get-buffer-create (generate-new-buffer-name " *temp file*"))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2782 (unwind-protect
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2783 (prog1
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2784 (with-current-buffer ,temp-buffer
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2785 ,@body)
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2786 (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
2787 (write-region nil nil ,temp-file nil 0)))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2788 (and (buffer-name ,temp-buffer)
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2789 (kill-buffer ,temp-buffer))))))
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2790
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2791 (defmacro with-temp-message (message &rest body)
24011
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
2792 "Display MESSAGE temporarily if non-nil while BODY is evaluated.
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2793 The original message is restored to the echo area after BODY has finished.
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2794 The value returned is the value of the last form in BODY.
24011
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
2795 MESSAGE is written to the message log buffer if `message-log-max' is non-nil.
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
2796 If MESSAGE is nil, the echo area and message log buffer are unchanged.
f36caedebd5f Doc fix.
Simon Marshall <simon@gnu.org>
parents: 24000
diff changeset
2797 Use a MESSAGE of \"\" to temporarily clear the echo area."
110034
c87f89486bb7 Use `declare' in defmacros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 110015
diff changeset
2798 (declare (debug t) (indent 1))
24000
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
2799 (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
2800 (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
2801 `(let ((,temp-message ,message)
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
2802 (,current-message))
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2803 (unwind-protect
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2804 (progn
24000
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
2805 (when ,temp-message
2de7db40964d (with-temp-message): Don't display MESSAGE if nil.
Simon Marshall <simon@gnu.org>
parents: 23907
diff changeset
2806 (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
2807 (message "%s" ,temp-message))
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2808 ,@body)
42076
d6765861f6ea (with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents: 41975
diff changeset
2809 (and ,temp-message
d6765861f6ea (with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents: 41975
diff changeset
2810 (if ,current-message
d6765861f6ea (with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents: 41975
diff changeset
2811 (message "%s" ,current-message)
d6765861f6ea (with-temp-message): At the end, always discard
Richard M. Stallman <rms@gnu.org>
parents: 41975
diff changeset
2812 (message nil)))))))
23736
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2813
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2814 (defmacro with-temp-buffer (&rest body)
a1b85478a209 Added with-temp-message.
Simon Marshall <simon@gnu.org>
parents: 23437
diff changeset
2815 "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
2816 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
2817 (declare (indent 0) (debug t))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2818 (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
2819 `(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
2820 ;; 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
2821 (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
2822 (unwind-protect
c15f559a5ada (with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93204
diff changeset
2823 (progn ,@body)
c15f559a5ada (with-temp-buffer): Assume kill-buffer can change current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 93204
diff changeset
2824 (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
2825 (kill-buffer ,temp-buffer)))))))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2826
104880
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2827 (defmacro with-silent-modifications (&rest body)
111936
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
2828 "Execute BODY, pretending it does not modify the buffer.
104880
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2829 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
2830 than cosmetic ones, undo data may become corrupted.
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2831 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
2832 affect the buffer's content."
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2833 (declare (debug t) (indent 0))
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2834 (let ((modified (make-symbol "modified")))
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2835 `(let* ((,modified (buffer-modified-p))
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2836 (buffer-undo-list t)
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2837 (inhibit-read-only t)
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2838 (inhibit-modification-hooks t)
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2839 deactivate-mark
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2840 ;; Avoid setting and removing file locks and checking
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2841 ;; 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
2842 buffer-file-name
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2843 buffer-file-truename)
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2844 (unwind-protect
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2845 (progn
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2846 ,@body)
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2847 (unless ,modified
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2848 (restore-buffer-modified-p nil))))))
02bf3383a22f (with-silent-modifications): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 104737
diff changeset
2849
16311
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
2850 (defmacro with-output-to-string (&rest body)
a56a8c6f2d8f (with-output-to-string): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16294
diff changeset
2851 "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
2852 (declare (indent 0) (debug t))
16379
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2853 `(let ((standard-output
dcc3625f52e2 (with-current-buffer): Minor cleanup.
Erik Naggum <erik@naggum.no>
parents: 16359
diff changeset
2854 (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
2855 (unwind-protect
5053145089c9 (with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents: 98071
diff changeset
2856 (progn
5053145089c9 (with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents: 98071
diff changeset
2857 (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
2858 ,@body)
5053145089c9 (with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents: 98071
diff changeset
2859 (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
2860 (buffer-string)))
5053145089c9 (with-output-to-string): Make sure that the temporary buffer gets
Romain Francoise <romain@orebokech.com>
parents: 98071
diff changeset
2861 (kill-buffer standard-output))))
16549
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2862
40822
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
2863 (defmacro with-local-quit (&rest body)
56565
1bef61b14e78 (with-local-quit): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 56537
diff changeset
2864 "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
2865 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
2866 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
2867 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
2868 (declare (debug t) (indent 0))
40822
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
2869 `(condition-case nil
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
2870 (let ((inhibit-quit nil))
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
2871 ,@body)
70901
cc60343f8fd6 (with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents: 70897
diff changeset
2872 (quit (setq quit-flag t)
cc60343f8fd6 (with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents: 70897
diff changeset
2873 ;; 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
2874 ;; in case inhibit-quit is nil.
cc60343f8fd6 (with-local-quit): When handling `quit' signal,
Richard M. Stallman <rms@gnu.org>
parents: 70897
diff changeset
2875 ;; 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
2876 ;; 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
2877 ;; 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
2878 (eval '(ignore nil)))))
40822
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
2879
58934
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2880 (defmacro while-no-input (&rest body)
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2881 "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
2882 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
2883 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
2884 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
2885 (declare (debug t) (indent 0))
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2886 (let ((catch-sym (make-symbol "input")))
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2887 `(with-local-quit
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2888 (catch ',catch-sym
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2889 (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
2890 (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
2891 (progn ,@body)))))))
58934
ee02b41be7da (while-no-input): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 58800
diff changeset
2892
81803
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2893 (defmacro condition-case-no-debug (var bodyform &rest handlers)
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2894 "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
2895 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
2896 (declare (debug condition-case) (indent 2))
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2897 (let ((bodysym (make-symbol "body")))
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2898 `(let ((,bodysym (lambda () ,bodyform)))
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2899 (if debug-on-error
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2900 (funcall ,bodysym)
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2901 (condition-case ,var
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2902 (funcall ,bodysym)
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2903 ,@handlers)))))
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2904
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2905 (defmacro with-demoted-errors (&rest body)
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2906 "Run BODY and demote any errors to simple messages.
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2907 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
2908 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
2909 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
2910 (declare (debug t) (indent 0))
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2911 (let ((err (make-symbol "err")))
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2912 `(condition-case-no-debug ,err
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2913 (progn ,@body)
111822
7a58c6c26566 * lisp/subr.el (with-demoted-errors): Distinguish symbols from strings.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 111626
diff changeset
2914 (error (message "Error: %S" ,err) nil))))
81803
f7d2bfbd3abc *** empty log message ***
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 81783
diff changeset
2915
16549
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2916 (defmacro combine-after-change-calls (&rest body)
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2917 "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
2918 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
2919 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
2920 when BODY is finished.
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
2921 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
2922
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2923 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
2924 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
2925
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2926 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
2927 in BODY."
51051
b39d8ed2d159 (with-selected-window): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 50694
diff changeset
2928 (declare (indent 0) (debug t))
16549
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2929 `(unwind-protect
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2930 (let ((combine-after-change-calls t))
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2931 . ,body)
30ddd0e52ace (combine-after-change-calls): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16437
diff changeset
2932 (combine-after-change-execute)))
76939
1b8e8619079e * subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents: 76583
diff changeset
2933
1b8e8619079e * subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents: 76583
diff changeset
2934 (defmacro with-case-table (table &rest body)
1b8e8619079e * subr.el (with-case-table): New macro.
Chong Yidong <cyd@stupidchicken.com>
parents: 76583
diff changeset
2935 "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
2936 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
2937 (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
2938 (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
2939 (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
2940 `(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
2941 (,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
2942 (unwind-protect
85841d693997 (with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents: 76939
diff changeset
2943 (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
2944 ,@body)
85841d693997 (with-case-table): Use `make-symbol' to avoid variable capture.
John Paul Wallington <jpw@pobox.com>
parents: 76939
diff changeset
2945 (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
2946 (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
2947
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
2948 ;;; Matching and match data.
44668
52222efc9d4d (insert-for-yank): New function.
Richard M. Stallman <rms@gnu.org>
parents: 44473
diff changeset
2949
15955
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
2950 (defvar save-match-data-internal)
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
2951
32d772cba2c1 (save-match-data): Use save-match-data-internal
Richard M. Stallman <rms@gnu.org>
parents: 15894
diff changeset
2952 ;; 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
2953 ;; 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
2954 ;; 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
2955 ;; 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
2956 (defmacro save-match-data (&rest body)
43527
d51d403fd80a (save-match-data): Doc fix.
Juanma Barranquero <lekktu@gmail.com>
parents: 43498
diff changeset
2957 "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
2958 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
2959 ;; It is better not to use backquote here,
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
2960 ;; because that makes a bootstrapping problem
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
2961 ;; 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
2962 (declare (indent 0) (debug t))
26084
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
2963 (list 'let
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
2964 '((save-match-data-internal (match-data)))
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
2965 (list 'unwind-protect
804cba424b64 Fix bootstrapping problems.
Paul Eggert <eggert@twinsun.com>
parents: 26002
diff changeset
2966 (cons 'progn body)
63664
f29e9a430d73 (save-match-data): Add comment about using evaporate arg
Kim F. Storm <storm@cua.dk>
parents: 63634
diff changeset
2967 ;; 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
2968 ;; 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
2969 '(set-match-data save-match-data-internal 'evaporate))))
144
535ec1aa78ef *** empty log message ***
Richard M. Stallman <rms@gnu.org>
parents: 114
diff changeset
2970
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
2971 (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
2972 "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
2973 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
2974 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
2975 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
2976 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
2977 (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
2978 (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
2979 (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
2980 (buffer-substring (match-beginning num) (match-end num)))))
10560
fd09d51dfd77 (match-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 10368
diff changeset
2981
20491
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
2982 (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
2983 "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
2984 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
2985 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
2986 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
2987 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
2988 (if (match-beginning num)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
2989 (if string
53994
342806d7b32b (match-string-no-properties): Use substring-no-properties.
Eli Zaretskii <eliz@is.elta.co.il>
parents: 53626
diff changeset
2990 (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
2991 (match-end num))
20491
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
2992 (buffer-substring-no-properties (match-beginning num)
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
2993 (match-end num)))))
d884af34ba47 (match-string-no-properties): New function.
Richard M. Stallman <rms@gnu.org>
parents: 20476
diff changeset
2994
86017
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
2995
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
2996 (defun match-substitute-replacement (replacement
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
2997 &optional fixedcase literal string subexp)
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
2998 "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
2999 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
3000 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
3001 Optional FIXEDCASE, LITERAL, STRING and SUBEXP have the same
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3002 meaning as for `replace-match'."
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3003 (let ((match (match-string 0 string)))
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3004 (save-match-data
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3005 (set-match-data (mapcar (lambda (x)
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3006 (if (numberp x)
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3007 (- x (match-beginning 0))
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3008 x))
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3009 (match-data t)))
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3010 (replace-match replacement fixedcase literal match subexp))))
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3011
484f09d924cf (match-substitute-replacement): New function.
Juri Linkov <juri@jurta.org>
parents: 85688
diff changeset
3012
62861
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3013 (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
3014 "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
3015 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
3016 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
3017 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
3018 before LIMIT.
62861
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3019
99356
d0975c52c7cc (looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 99327
diff changeset
3020 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
3021 possible, stopping when a single additional previous character
d0975c52c7cc (looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 99327
diff changeset
3022 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
3023 extended, its starting position is allowed to occur before
99356
d0975c52c7cc (looking-back): Doc fix.
Chong Yidong <cyd@stupidchicken.com>
parents: 99327
diff changeset
3024 LIMIT."
62861
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3025 (let ((start (point))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3026 (pos
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3027 (save-excursion
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3028 (and (re-search-backward (concat "\\(?:" regexp "\\)\\=") limit t)
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3029 (point)))))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3030 (if (and greedy pos)
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3031 (save-restriction
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3032 (narrow-to-region (point-min) start)
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3033 (while (and (> pos (point-min))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3034 (save-excursion
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3035 (goto-char pos)
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3036 (backward-char 1)
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3037 (looking-at (concat "\\(?:" regexp "\\)\\'"))))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3038 (setq pos (1- pos)))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3039 (save-excursion
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3040 (goto-char pos)
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3041 (looking-at (concat "\\(?:" regexp "\\)\\'")))))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3042 (not (null pos))))
0d5825b4e125 (looking-back): New argument GREEDY.
Richard M. Stallman <rms@gnu.org>
parents: 62710
diff changeset
3043
81783
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3044 (defsubst looking-at-p (regexp)
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3045 "\
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3046 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
3047 (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
3048 (looking-at regexp)))
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3049
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3050 (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
3051 "\
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3052 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
3053 (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
3054 (string-match regexp string start)))
f1d802f34413 (looking-at-p, string-match-p): New functions.
Richard M. Stallman <rms@gnu.org>
parents: 81765
diff changeset
3055
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3056 (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
3057 "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
3058 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
3059 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
3060 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
3061 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
3062 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
3063 ;; 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
3064 ;; 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
3065 ;; 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
3066 ;; error string.
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3067 (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
3068 (progn
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3069 (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
3070 t)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3071 (invalid-regexp
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3072 (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
3073 "Unmatched \\{"
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3074 "Trailing backslash")))))
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3075 ;; 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
3076 ;; (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
3077 ;; (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
3078 ;; (harmless-esc "\\\\[^{]")
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3079 ;; (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
3080 ;; (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
3081 ;; (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
3082 ;; (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
3083 ;; "\\|" 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
3084 ;; (class
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3085 ;; (concat "\\[^?]?"
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3086 ;; "\\(" 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
3087 ;; "\\|" class-lb "\\)*"
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3088 ;; "\\[?]")) ; 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
3089 ;; (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
3090 ;; (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
3091 ;; "\\|" class "\\|" braces "\\)*\\'"))
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3092 ;; "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
3093 ;; (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
3094 )
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3095
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3096 ;;;; split-string
51339
14976a545668 (looking-back): New function to check for regular expression before point.
Juanma Barranquero <lekktu@gmail.com>
parents: 51148
diff changeset
3097
51148
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3098 (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
3099 "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
3100
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3101 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
3102 \(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
3103
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3104 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
3105 likely to have undesired semantics.")
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3106
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3107 ;; 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
3108 ;; 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
3109 ;; 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
3110 ;; 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
3111 (defun split-string (string &optional separators omit-nulls)
57006
a806a6bbc178 (split-string): Docfix.
Thien-Thi Nguyen <ttn@gnuvola.org>
parents: 56826
diff changeset
3112 "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
3113
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3114 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
3115 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
3116 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
3117 which is returned.
51148
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3118
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3119 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
3120 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
3121 `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
3122 OMIT-NULLS is forced to t.
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3123
55406
3b27c2f86c7a (lambda): Add arglist description to docstring.
Juanma Barranquero <lekktu@gmail.com>
parents: 55232
diff changeset
3124 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
3125 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
3126 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
3127 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
3128
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3129 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
3130 `(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
3131 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
3132 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
3133
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3134 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
3135 (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
3136 (rexp (or separators split-string-default-separators))
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3137 (start 0)
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3138 notfirst
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3139 (list nil))
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3140 (while (and (string-match rexp string
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3141 (if (and notfirst
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3142 (= start (match-beginning 0))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3143 (< start (length string)))
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3144 (1+ start) start))
51148
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3145 (< start (length string)))
20476
f213a5906ea6 (split-string): Handle empty matches reasonably.
Richard M. Stallman <rms@gnu.org>
parents: 20472
diff changeset
3146 (setq notfirst t)
51148
f59aeee43725 (split-string): Implement specification that splitting on explicit separators
Juanma Barranquero <lekktu@gmail.com>
parents: 51068
diff changeset
3147 (if (or keep-nulls (< start (match-beginning 0)))
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3148 (setq list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3149 (cons (substring string start (match-beginning 0))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3150 list)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3151 (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
3152 (if (or keep-nulls (< start (length string)))
16314
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3153 (setq list
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3154 (cons (substring string start)
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3155 list)))
c72b7ee606a3 (split-string): New function.
Richard M. Stallman <rms@gnu.org>
parents: 16311
diff changeset
3156 (nreverse list)))
78081
d53cb34bfd32 * pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents: 77423
diff changeset
3157
78530
1532be3afc8a (combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents: 78236
diff changeset
3158 (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
3159 "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
3160 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
3161 (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
3162 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
3163 (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
3164 (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
3165 (mapconcat
d53cb34bfd32 * pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents: 77423
diff changeset
3166 (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
3167 (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
3168 (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
3169 str))
d53cb34bfd32 * pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents: 77423
diff changeset
3170 strings sep)))
d53cb34bfd32 * pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents: 77423
diff changeset
3171
78530
1532be3afc8a (combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents: 78236
diff changeset
3172 (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
3173 "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
3174 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
3175 (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
3176 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
3177 (let ((sep (or separator "\\s-+"))
98942
24d03d4e9afe (split-string-and-unquote): Simplify regexp.
Andreas Schwab <schwab@suse.de>
parents: 98939
diff changeset
3178 (i (string-match "\"" string)))
78530
1532be3afc8a (combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents: 78236
diff changeset
3179 (if (null i)
1532be3afc8a (combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents: 78236
diff changeset
3180 (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
3181 (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
3182 (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
3183 (cons (car rfs)
78530
1532be3afc8a (combine-and-quote-strings): Renamed from strings->string.
Richard M. Stallman <rms@gnu.org>
parents: 78236
diff changeset
3184 (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
3185 sep)))))))
78081
d53cb34bfd32 * pcvs-util.el (cvs-strings->string, cvs-string->strings):
Nick Roberts <nickrob@snap.net.nz>
parents: 77423
diff changeset
3186
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3187
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3188 ;;;; Replacement in strings.
24089
70954a8be49b (subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents: 24011
diff changeset
3189
70954a8be49b (subst-char-in-string): New function.
Andrew Innes <andrewi@gnu.org>
parents: 24011
diff changeset
3190 (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
3191 "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
3192 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
3193 (let ((i (length string))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
3194 (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
3195 (while (> i 0)
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
3196 (setq i (1- i))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
3197 (if (eq (aref newstr i) fromchar)
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
3198 (aset newstr i tochar)))
1b1555d26963 Undoing the changes erroneously committed just before.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 33833
diff changeset
3199 newstr))
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3200
28148
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
3201 (defun replace-regexp-in-string (regexp rep string &optional
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
3202 fixedcase literal subexp start)
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3203 "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
3204
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3205 Return a new string containing the replacements.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3206
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3207 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
3208 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
3209 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
3210
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3211 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
3212 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
3213 match, and its value is used as the replacement text. When REP is called,
112188
28f569136b3e * lisp/subr.el (eval-after-load): Fix timing for features.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 112171
diff changeset
3214 the match data are the result of matching REGEXP against a substring
65058
de7df04c6d6b (replace-regexp-in-string): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents: 65014
diff changeset
3215 of STRING.
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3216
28148
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
3217 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
3218 and replace a sub-expression, e.g.
48077
69077a78e52f (replace-regexp-in-string): Doc fix.
Andreas Schwab <schwab@suse.de>
parents: 47916
diff changeset
3219 (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
3220 => \" bar foo\"
0f14966fe791 (replace-regexp-in-string): Renamed from
Dave Love <fx@gnu.org>
parents: 28065
diff changeset
3221 "
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3222
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3223 ;; 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
3224 ;; 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
3225 ;; 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
3226 ;; 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
3227 ;; 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
3228 ;; [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
3229 ;; 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
3230 ;; 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
3231 ;; 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
3232 (let ((l (length string))
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3233 (start (or start 0))
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3234 matches str mb me)
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3235 (save-match-data
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3236 (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
3237 (setq mb (match-beginning 0)
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3238 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
3239 ;; 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
3240 (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
3241 ;; 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
3242 ;; 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
3243 ;; 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
3244 ;; 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
3245 ;; 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
3246 (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
3247 (setq matches
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
3248 (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
3249 rep
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
3250 (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
3251 fixedcase literal str subexp)
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
3252 (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
3253 matches)))
093dcd5f39b2 (replace-regexps-in-string): Properly handle the case where
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 27908
diff changeset
3254 (setq start me))
27810
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3255 ;; Reconstruct a string from the pieces.
1d7650c95e0a (when, unless, split-string): Doc fix.
Dave Love <fx@gnu.org>
parents: 27482
diff changeset
3256 (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
3257 (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
3258
106232
f44541b1d13c (string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105950
diff changeset
3259 (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
3260 "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
3261 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
3262 to case differences."
f44541b1d13c (string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105950
diff changeset
3263 (eq t (compare-strings str1 nil nil
f44541b1d13c (string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105950
diff changeset
3264 str2 0 (length str1) ignore-case)))
f44541b1d13c (string-prefix-p): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 105950
diff changeset
3265
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3266 ;;;; invisibility specs
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3267
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3268 (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
3269 "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
3270 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
3271 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
3272 (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
3273 (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
3274 (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
3275 (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
3276
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3277 (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
3278 "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
3279 (if (consp buffer-invisibility-spec)
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
3280 (setq buffer-invisibility-spec
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
3281 (delete element buffer-invisibility-spec))))
16359
18cc78dc8b18 (with-temp-file): New macro.
Richard M. Stallman <rms@gnu.org>
parents: 16333
diff changeset
3282
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3283 ;;;; Syntax tables.
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3284
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3285 (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
3286 "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
3287 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
3288 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
3289 Value is what BODY returns."
110034
c87f89486bb7 Use `declare' in defmacros.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 110015
diff changeset
3290 (declare (debug t) (indent 1))
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3291 (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
3292 (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
3293 `(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
3294 (,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
3295 (unwind-protect
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3296 (progn
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3297 (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
3298 ,@body)
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3299 (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
3300 (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
3301 (set-syntax-table ,old-table))))))
5385
53077bf7c718 (shell-quote-argument): New function.
Richard M. Stallman <rms@gnu.org>
parents: 5302
diff changeset
3302
5844
445de172c217 (make-syntax-table): Behave like copy-syntax-table if an argument is given,
Karl Heuer <kwzh@gnu.org>
parents: 5460
diff changeset
3303 (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
3304 "Return a new syntax table.
40822
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
3305 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
3306 from `standard-syntax-table' otherwise."
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
3307 (let ((table (make-char-table 'syntax-table nil)))
b10e7d6fb95b (with-local-quit): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 40282
diff changeset
3308 (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
3309 table))
17146
b8536e42d4ef (combine-after-change-calls): Doc fix.
Karl Heuer <kwzh@gnu.org>
parents: 16845
diff changeset
3310
47355
9e3ee43b5262 (symbol-file): Also work for autoloaded funcs.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47305
diff changeset
3311 (defun syntax-after (pos)
61798
994a6fb78d4c (syntax-after): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 61716
diff changeset
3312 "Return the raw syntax of the char after POS.
994a6fb78d4c (syntax-after): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 61716
diff changeset
3313 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
3314 (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
3315 (let ((st (if parse-sexp-lookup-properties
28906724d6e3 (syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 58272
diff changeset
3316 (get-char-property pos 'syntax-table))))
28906724d6e3 (syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 58272
diff changeset
3317 (if (consp st) st
28906724d6e3 (syntax-after): Undo last change.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 58272
diff changeset
3318 (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
3319
61669
c95f35bea727 (syntax-class): New function.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 60764
diff changeset
3320 (defun syntax-class (syntax)
61798
994a6fb78d4c (syntax-after): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 61716
diff changeset
3321 "Return the syntax class part of the syntax descriptor SYNTAX.
994a6fb78d4c (syntax-after): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 61716
diff changeset
3322 If SYNTAX is nil, return nil."
994a6fb78d4c (syntax-after): Doc fix.
Eli Zaretskii <eliz@gnu.org>
parents: 61716
diff changeset
3323 (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
3324
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3325 ;;;; 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
3326
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 (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
3328 "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
3329 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
3330 (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
3331 (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
3332 (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
3333 (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
3334 (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
3335 (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
3336 (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
3337 ;; 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
3338 (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
3339 (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
3340 (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
3341 (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
3342 (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
3343 (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
3344 ;; 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
3345 (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
3346 (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
3347 ;; 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
3348 (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
3349 (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
3350 (+ (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
3351 (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
3352 ;; 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
3353 (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
3354 (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
3355 (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
3356 ;; 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
3357 (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
3358 (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
3359 (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
3360 (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
3361 (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
3362 (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
3363 (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
3364 (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
3365 (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
3366 (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
3367 ;;(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
3368 (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
3369 (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
3370 (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
3371 (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
3372 ;;(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
3373 ))))
7f05eff77ea2 (delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39725
diff changeset
3374 (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
3375
7f05eff77ea2 (delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39725
diff changeset
3376 (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
3377 "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
3378 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
3379 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
3380
7f05eff77ea2 (delay-mode-hooks, delayed-mode-hooks, run-mode-hooks): New vars and functions.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 39725
diff changeset
3381 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
3382 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
3383 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
3384 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
3385 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
3386 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
3387 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
3388 ;; 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
3389 ;; 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
3390 ;; (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
3391 ;; 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
3392 ;; 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
3393 ;; 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
3394 ;; `evaporate' to make sure those overlays get deleted when needed).
47916
0bb8dc016c43 (remq): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 47747
diff changeset
3395 ;;
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
3396 (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
3397 (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
3398 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
3399 (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
3400 (>= 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
3401 (>= 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
3402 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
3403 (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
3404 (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
3405 (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
3406 (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
3407 (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
3408 (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
3409 ;;(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
3410 (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
3411 (overlay-put ol1 'text-clones dups)
47916
0bb8dc016c43 (remq): Fix typo.
Juanma Barranquero <lekktu@gmail.com>
parents: 47747
diff changeset
3412 ;;
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
3413 (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
3414 (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
3415 (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
3416 ;;(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
3417 (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
3418 (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
3419
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3420 ;;;; 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
3421
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3422 ;; 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
3423 ;; to define them.
44422
5f7f8b191a8c (play-sound): Move here from simple.el.
Pavel Janík <Pavel@Janik.cz>
parents: 44285
diff changeset
3424
47406
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3425 (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
3426 &optional abortfunc hookvar)
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3427 "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
3428
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3429 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
3430 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
3431 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
3432
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3433 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
3434 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
3435 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
3436 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
3437 by default.
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3438
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3439 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
3440 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
3441
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3442 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
3443
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3444 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
3445 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
3446 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
3447
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3448 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
3449 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
3450 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
3451 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
3452
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3453 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
3454 `abortfunc', and `hookvar'."
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3455 (put symbol 'composefunc composefunc)
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3456 (put symbol 'sendfunc sendfunc)
fbd7a9a8682c (define-mail-user-agent): Moved from simple.el.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 47355
diff changeset
3457 (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
3458 (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
3459
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3460 ;;;; Progress reporters.
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3461
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3462 ;; Progress reporter has the following structure:
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3463 ;;
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3464 ;; (NEXT-UPDATE-VALUE . [NEXT-UPDATE-TIME
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3465 ;; MIN-VALUE
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3466 ;; MAX-VALUE
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3467 ;; MESSAGE
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3468 ;; MIN-CHANGE
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3469 ;; MIN-TIME])
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3470 ;;
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3471 ;; This weirdeness is for optimization reasons: we want
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3472 ;; `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
3473 ;; `(car reporter)' is better than `(aref reporter 0)'.
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3474 ;;
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3475 ;; 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
3476 ;; 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
3477 ;; hand, it greatly simplifies the code.
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3478
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3479 (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
3480 "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
3481 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
3482
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3483 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
3484 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
3485 `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
3486 MIN-VALUE and MAX-VALUE.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3487
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3488 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
3489
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3490 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
3491 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
3492 nothing."
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3493 (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
3494 (>= 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
3495 (progress-reporter-do-update reporter value)))
601c087f45f6 (progress-reporter-update): Define before first usage.
Kim F. Storm <storm@cua.dk>
parents: 57384
diff changeset
3496
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3497 (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
3498 current-value min-change min-time)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3499 "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
3500
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3501 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
3502 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
3503 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
3504 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
3505 `progress-reporter-force-update'.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3506
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3507 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
3508 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
3509 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
3510 progress.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3511
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3512 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
3513 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
3514
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3515 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
3516 MIN-VALUE.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3517 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
3518 the default is 1%.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3519 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
3520 and/or MAX-VALUE are nil.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3521
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3522 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
3523 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
3524 `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
3525 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
3526 parameter is effectively rounded up."
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3527 (unless min-time
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3528 (setq min-time 0.2))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3529 (let ((reporter
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3530 ;; Force a call to `message' now
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3531 (cons (or min-value 0)
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3532 (vector (if (and (fboundp 'float-time)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3533 (>= min-time 0.02))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3534 (float-time) nil)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3535 min-value
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3536 max-value
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3537 message
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3538 (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
3539 min-time))))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3540 (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
3541 reporter))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3542
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3543 (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
3544 "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
3545
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3546 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
3547 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
3548 (let ((parameters (cdr reporter)))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3549 (when new-message
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3550 (aset parameters 3 new-message))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3551 (when (aref parameters 0)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3552 (aset parameters 0 (float-time)))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3553 (progress-reporter-do-update reporter value)))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3554
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3555 (defvar progress-reporter--pulse-characters ["-" "\\" "|" "/"]
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3556 "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
3557
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3558 (defun progress-reporter-do-update (reporter value)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3559 (let* ((parameters (cdr reporter))
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3560 (update-time (aref parameters 0))
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3561 (min-value (aref parameters 1))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3562 (max-value (aref parameters 2))
107573
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3563 (text (aref parameters 3))
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3564 (current-time (float-time))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3565 (enough-time-passed
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3566 ;; 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
3567 (or (not update-time)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3568 (when (>= current-time update-time)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3569 ;; Calculate time for the next update
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3570 (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
3571 (cond ((and min-value max-value)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3572 ;; Numerical indicator
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3573 (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
3574 (percentage (if (= max-value min-value)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3575 0
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3576 (truncate (/ (- value min-value)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3577 one-percent)))))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3578 ;; 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
3579 ;; 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
3580 ;; 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
3581 ;; area updates closer to MIN-TIME.
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3582 (setcar reporter
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3583 (min (+ min-value (* (+ percentage
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3584 (if enough-time-passed
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3585 ;; MIN-CHANGE
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3586 (aref parameters 4)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3587 1))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3588 one-percent))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3589 max-value))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3590 (when (integerp value)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3591 (setcar reporter (ceiling (car reporter))))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3592 ;; 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
3593 (when enough-time-passed
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3594 (if (> percentage 0)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3595 (message "%s%d%%" text percentage)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3596 (message "%s" text)))))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3597 ;; Pulsing indicator
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3598 (enough-time-passed
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3599 (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
3600 (message-log-max nil))
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3601 (setcar reporter index)
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3602 (message "%s %s"
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3603 text
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3604 (aref progress-reporter--pulse-characters
954352cc49bd * subr.el: Extend progress reporters to perform "spinning".
Chong Yidong <cyd@stupidchicken.com>
parents: 107329
diff changeset
3605 index)))))))
57384
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3606
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3607 (defun progress-reporter-done (reporter)
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3608 "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
3609 (message "%sdone" (aref (cdr reporter) 3)))
78290fa43da5 (make-progress-reporter, progress-reporter-update)
Eli Zaretskii <eliz@gnu.org>
parents: 57215
diff changeset
3610
59648
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3611 (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
3612 "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
3613 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
3614 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
3615 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
3616
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3617 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
3618 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
3619 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
3620 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
3621
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3622 \(fn (VAR COUNT [RESULT]) MESSAGE BODY...)"
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3623 (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
3624 (let ((temp (make-symbol "--dotimes-temp--"))
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3625 (temp2 (make-symbol "--dotimes-temp2--"))
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3626 (start 0)
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3627 (end (nth 1 spec)))
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3628 `(let ((,temp ,end)
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3629 (,(car spec) ,start)
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3630 (,temp2 (make-progress-reporter ,message ,start ,end)))
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3631 (while (< ,(car spec) ,temp)
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3632 ,@body
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3633 (progress-reporter-update ,temp2
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3634 (setq ,(car spec) (1+ ,(car spec)))))
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3635 (progress-reporter-done ,temp2)
3054e8b6e73e (dotimes-with-progress-reporter): New macro.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 59161
diff changeset
3636 nil ,@(cdr (cdr spec)))))
65150
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3637
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3638
66304
f754be327a7e Much rearrangement of functions and division into pages. No code changes.
Richard M. Stallman <rms@gnu.org>
parents: 66286
diff changeset
3639 ;;;; Comparing version strings.
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3640
105950
e411fa8e0abf * progmodes/grep.el (grep-regexp-alist):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105944
diff changeset
3641 (defconst version-separator "."
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3642 "Specify the string used to separate the version elements.
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3643
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3644 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
3645
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3646
105950
e411fa8e0abf * progmodes/grep.el (grep-regexp-alist):
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105944
diff changeset
3647 (defconst version-regexp-alist
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3648 '(("^[-_+ ]?alpha$" . -3)
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3649 ("^[-_+]$" . -3) ; treat "1.2.3-20050920" and "1.2-3" as alpha releases
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3650 ("^[-_+ ]cvs$" . -3) ; treat "1.2.3-CVS" as alpha release
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3651 ("^[-_+ ]?beta$" . -2)
110013
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3652 ("^[-_+ ]?\\(pre\\|rcc\\)$" . -1))
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3653 "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
3654
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3655 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
3656 \"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
3657 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
3658
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3659 String Version Integer List Version
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3660 \"1.0pre2\" (1 0 -1 2)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3661 \"1.0PRE2\" (1 0 -1 2)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3662 \"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
3663 \"22.8 Beta3\" (22 8 -2 3)
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3664 \"0.9alpha1\" (0 9 -3 1)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3665 \"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
3666 \"0.9 alpha\" (0 9 -3)
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3667
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3668 Each element has the following form:
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3669
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3670 (REGEXP . PRIORITY)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3671
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3672 Where:
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3673
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3674 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
3675 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
3676 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
3677 REGEXP.
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3678
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3679 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
3680
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3681
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3682 (defun version-to-list (ver)
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3683 "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
3684
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3685 The version syntax is given by the following EBNF:
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3686
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3687 VERSION ::= NUMBER ( SEPARATOR NUMBER )*.
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3688
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3689 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
3690
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3691 SEPARATOR ::= `version-separator' (which see)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3692 | `version-regexp-alist' (which see).
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3693
65668
bbff73cbd15c (version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents: 65150
diff changeset
3694 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
3695 in `version-regexp-alist'.
bbff73cbd15c (version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents: 65150
diff changeset
3696
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3697 Examples of valid version syntax:
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3698
65668
bbff73cbd15c (version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents: 65150
diff changeset
3699 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
3700
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3701 Examples of invalid version syntax:
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3702
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3703 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
3704
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3705 Examples of version conversion:
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3706
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3707 Version String Version as a List of Integers
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3708 \"1.0.7.5\" (1 0 7 5)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3709 \"1.0pre2\" (1 0 -1 2)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3710 \"1.0PRE2\" (1 0 -1 2)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3711 \"22.8beta3\" (22 8 -2 3)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3712 \"22.8Beta3\" (22 8 -2 3)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3713 \"0.9alpha1\" (0 9 -3 1)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3714 \"0.9AlphA1\" (0 9 -3 1)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3715 \"0.9alpha\" (0 9 -3)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3716
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3717 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
3718 (or (and (stringp ver) (> (length ver) 0))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3719 (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
3720 ;; 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
3721 (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
3722 (string-equal (substring ver 0 (length version-separator))
77092
055a54275ec3 Fix indentation.
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 76960
diff changeset
3723 version-separator))
67541
f9d4913b40bc (version-regexp-alist): Allow space as separator before
Kim F. Storm <storm@cua.dk>
parents: 67274
diff changeset
3724 (setq ver (concat "0" ver)))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3725 (save-match-data
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3726 (let ((i 0)
65668
bbff73cbd15c (version-regexp-alist): Extend valid syntax for version strings:
Eli Zaretskii <eliz@gnu.org>
parents: 65150
diff changeset
3727 (case-fold-search t) ; ignore case in matching
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3728 lst s al)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3729 (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
3730 (= s i))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3731 ;; handle numeric part
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3732 (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
3733 lst)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3734 i (match-end 0))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3735 ;; handle non-numeric part
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3736 (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
3737 (= s i))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3738 (setq s (substring ver i (match-end 0))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3739 i (match-end 0))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3740 ;; handle alpha, beta, pre, etc. separator
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3741 (unless (string= s version-separator)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3742 (setq al version-regexp-alist)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3743 (while (and al (not (string-match (caar al) s)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3744 (setq al (cdr al)))
110013
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3745 (cond (al
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3746 (push (cdar al) lst))
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3747 ;; Convert 22.3a to 22.3.1, 22.3b to 22.3.2, etc.
110013
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3748 ((string-match "^[-_+ ]?\\([a-zA-Z]\\)$" s)
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3749 (push (- (aref (downcase (match-string 1 s)) 0) ?a -1)
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3750 lst))
0fb70b0c7489 Let version-to-list handle versions like "10.3d".
Chong Yidong <cyd@stupidchicken.com>
parents: 109954
diff changeset
3751 (t (error "Invalid version syntax: '%s'" ver))))))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3752 (if (null lst)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3753 (error "Invalid version syntax: '%s'" ver)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3754 (nreverse lst)))))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3755
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3756
65150
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3757 (defun version-list-< (l1 l2)
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3758 "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
3759
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3760 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
3761 \(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
3762 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
3763 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
3764 (while (and l1 l2 (= (car l1) (car l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3765 (setq l1 (cdr l1)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3766 l2 (cdr l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3767 (cond
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3768 ;; l1 not null and l2 not null
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3769 ((and l1 l2) (< (car l1) (car l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3770 ;; l1 null and l2 null ==> l1 length = l2 length
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3771 ((and (null l1) (null l2)) nil)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3772 ;; 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
3773 (l1 (< (version-list-not-zero l1) 0))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3774 ;; 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
3775 (t (< 0 (version-list-not-zero l2)))))
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3776
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3777
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3778 (defun version-list-= (l1 l2)
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3779 "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
3780
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3781 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
3782 \(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
3783 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
3784 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
3785 (while (and l1 l2 (= (car l1) (car l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3786 (setq l1 (cdr l1)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3787 l2 (cdr l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3788 (cond
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3789 ;; l1 not null and l2 not null
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3790 ((and l1 l2) nil)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3791 ;; l1 null and l2 null ==> l1 length = l2 length
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3792 ((and (null l1) (null l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3793 ;; 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
3794 (l1 (zerop (version-list-not-zero l1)))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3795 ;; 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
3796 (t (zerop (version-list-not-zero l2)))))
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3797
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3798
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3799 (defun version-list-<= (l1 l2)
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3800 "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
3801
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3802 Note that integer list (1) is equal to (1 0), (1 0 0), (1 0 0 0),
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3803 etc. That is, the trailing zeroes are insignificant. Also, integer
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3804 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
3805 which is greater than (1 -3)."
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3806 (while (and l1 l2 (= (car l1) (car l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3807 (setq l1 (cdr l1)
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3808 l2 (cdr l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3809 (cond
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3810 ;; l1 not null and l2 not null
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3811 ((and l1 l2) (< (car l1) (car l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3812 ;; l1 null and l2 null ==> l1 length = l2 length
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3813 ((and (null l1) (null l2)))
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3814 ;; 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
3815 (l1 (<= (version-list-not-zero l1) 0))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3816 ;; 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
3817 (t (<= 0 (version-list-not-zero l2)))))
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3818
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3819 (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
3820 "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
3821
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3822 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
3823 (while (and lst (zerop (car lst)))
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3824 (setq lst (cdr lst)))
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3825 (if lst
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3826 (car lst)
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3827 ;; there is no element different of zero
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3828 0))
65105
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3829
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3830
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3831 (defun version< (v1 v2)
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3832 "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
3833
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3834 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
3835 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
3836 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
3837 which is higher than \"1alpha\"."
65150
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3838 (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
3839
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3840
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3841 (defun version<= (v1 v2)
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3842 "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
3843
aad2616355a4 version string comparison
Vinicius Jose Latorre <viniciusjl@ig.com.br>
parents: 65058
diff changeset
3844 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3845 etc. That is, the trailing \".0\"s are insignificant. Also, version
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3846 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
3847 which is higher than \"1alpha\"."
65150
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3848 (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
3849
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3850 (defun version= (v1 v2)
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3851 "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
3852
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3853 Note that version string \"1\" is equal to \"1.0\", \"1.0.0\", \"1.0.0.0\",
111315
bad40b05a0df Adjust doc.
Vinicius Jose Latorre <viniciusjl@ig.com.br
parents: 110972
diff changeset
3854 etc. That is, the trailing \".0\"s are insignificant. Also, version
107684
1d43618b7e72 Fix doc strings of version-* functions and variables.
Eli Zaretskii <eliz@gnu.org>
parents: 107329
diff changeset
3855 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
3856 which is higher than \"1alpha\"."
65150
6d566cf5ad51 (version-list-<, version-list-<=, version-list-=)
Kim F. Storm <storm@cua.dk>
parents: 65114
diff changeset
3857 (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
3858
104215
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3859
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3860 ;;; Misc.
105940
f7147d70f6ef * subr.el (menu-bar-separator): New defconst.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105939
diff changeset
3861 (defconst menu-bar-separator '("--")
f7147d70f6ef * subr.el (menu-bar-separator): New defconst.
Dan Nicolaescu <dann@ics.uci.edu>
parents: 105939
diff changeset
3862 "Separator for menus.")
104215
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3863
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3864 ;; 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
3865 ;; be used there.
111936
0a0aa7fbe2ca Doc fixes.
Glenn Morris <rgm@gnu.org>
parents: 111905
diff changeset
3866 ;; http://lists.gnu.org/archive/html/emacs-devel/2009-08/msg00236.html
104215
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3867 (when (hash-table-p (car (read-from-string
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3868 (prin1-to-string (make-hash-table)))))
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3869 (provide 'hashtable-print-readable))
eec5a3966960 * subr.el: Provide hashtable-print-readable.
Chong Yidong <cyd@stupidchicken.com>
parents: 103970
diff changeset
3870
787
3cece0106722 *** empty log message ***
Eric S. Raymond <esr@snark.thyrsus.com>
parents: 779
diff changeset
3871 ;;; subr.el ends here