annotate lisp/subr.el @ 444:576fb035e263 r21-2-37

Import from CVS: tag r21-2-37
author cvs
date Mon, 13 Aug 2007 11:36:19 +0200
parents abe6d1db359e
children 68eb53e4b7e5
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
1 ;;; subr.el --- basic lisp subroutines for XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
2
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
3 ;; Copyright (C) 1985, 1986, 1992, 1994-5, 1997 Free Software Foundation, Inc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
4 ;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
5 ;; Copyright (C) 1995 Sun Microsystems.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
6 ;; Copyright (C) 2000 Ben Wing.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
7
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
8 ;; Maintainer: XEmacs Development Team
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
9 ;; Keywords: extensions, dumped
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
10
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
11 ;; This file is part of XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
12
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
13 ;; XEmacs is free software; you can redistribute it and/or modify it
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
14 ;; under the terms of the GNU General Public License as published by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
15 ;; the Free Software Foundation; either version 2, or (at your option)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
16 ;; any later version.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
17
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
18 ;; XEmacs is distributed in the hope that it will be useful, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
19 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
21 ;; General Public License for more details.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
22
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
23 ;; You should have received a copy of the GNU General Public License
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
24 ;; along with XEmacs; see the file COPYING. If not, write to the Free
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
25 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
26 ;; 02111-1307, USA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
27
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
28 ;;; Synched up with: FSF 19.34.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
29
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
30 ;;; Commentary:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
31
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
32 ;; This file is dumped with XEmacs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
33
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
34 ;; There's not a whole lot in common now with the FSF version,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
35 ;; be wary when applying differences. I've left in a number of lines
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
36 ;; of commentary just to give diff(1) something to synch itself with to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
37 ;; provide useful context diffs. -sb
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
38
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
39 ;;; Code:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
40
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
41
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
42 ;;;; Lisp language features.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
43
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
44 (defmacro lambda (&rest cdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
45 "Return a lambda expression.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
46 A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
47 self-quoting; the result of evaluating the lambda expression is the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
48 expression itself. The lambda expression may then be treated as a
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
49 function, i.e., stored as the function value of a symbol, passed to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
50 funcall or mapcar, etc.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
51
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
52 ARGS should take the same form as an argument list for a `defun'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
53 DOCSTRING is an optional documentation string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
54 If present, it should describe how to call the function.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
55 But documentation strings are usually not useful in nameless functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
56 INTERACTIVE should be a call to the function `interactive', which see.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
57 It may also be omitted.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
58 BODY should be a list of lisp expressions."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
59 `(function (lambda ,@cdr)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
60
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
61 (defmacro defun-when-void (&rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
62 "Define a function, just like `defun', unless it's already defined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
63 Used for compatibility among different emacs variants."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
64 `(if (fboundp ',(car args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
65 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
66 (defun ,@args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
67
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
68 (defmacro define-function-when-void (&rest args)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
69 "Define a function, just like `define-function', unless it's already defined.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
70 Used for compatibility among different emacs variants."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
71 `(if (fboundp ,(car args))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
72 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
73 (define-function ,@args)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
74
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
75
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
76 ;;;; Keymap support.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
77 ;; XEmacs: removed to keymap.el
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
78
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
79 ;;;; The global keymap tree.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
80
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
81 ;;; global-map, esc-map, and ctl-x-map have their values set up in
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
82 ;;; keymap.c; we just give them docstrings here.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
83
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
84 ;;;; Event manipulation functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
85
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
86 ;; XEmacs: This stuff is done in C Code.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
87
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
88 ;;;; Obsolescent names for functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
89 ;; XEmacs: not used.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
90
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
91 ;; XEmacs:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
92 (defun local-variable-if-set-p (sym buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
93 "Return t if SYM would be local to BUFFER after it is set.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
94 A nil value for BUFFER is *not* the same as (current-buffer), but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
95 can be used to determine whether `make-variable-buffer-local' has been
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
96 called on SYM."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
97 (local-variable-p sym buffer t))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
98
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
99
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
100 ;;;; Hook manipulation functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
101
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
102 ;; (defconst run-hooks 'run-hooks ...)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
103
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
104 (defun make-local-hook (hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
105 "Make the hook HOOK local to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
106 When a hook is local, its local and global values
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
107 work in concert: running the hook actually runs all the hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
108 functions listed in *either* the local value *or* the global value
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
109 of the hook variable.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
110
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
111 This function works by making `t' a member of the buffer-local value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
112 which acts as a flag to run the hook functions in the default value as
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
113 well. This works for all normal hooks, but does not work for most
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
114 non-normal hooks yet. We will be changing the callers of non-normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
115 hooks so that they can handle localness; this has to be done one by
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
116 one.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
117
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
118 This function does nothing if HOOK is already local in the current
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
119 buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
120
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
121 Do not use `make-local-variable' to make a hook variable buffer-local.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
122
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
123 See also `add-local-hook' and `remove-local-hook'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
124 (if (local-variable-p hook (current-buffer)) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
125 nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
126 (or (boundp hook) (set hook nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
127 (make-local-variable hook)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
128 (set hook (list t))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
129
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
130 (defun add-hook (hook function &optional append local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
131 "Add to the value of HOOK the function FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
132 FUNCTION is not added if already present.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
133 FUNCTION is added (if necessary) at the beginning of the hook list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
134 unless the optional argument APPEND is non-nil, in which case
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
135 FUNCTION is added at the end.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
136
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
137 The optional fourth argument, LOCAL, if non-nil, says to modify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
138 the hook's buffer-local value rather than its default value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
139 This makes no difference if the hook is not buffer-local.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
140 To make a hook variable buffer-local, always use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
141 `make-local-hook', not `make-local-variable'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
142
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
143 HOOK should be a symbol, and FUNCTION may be any valid function. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
144 HOOK is void, it is first set to nil. If HOOK's value is a single
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
145 function, it is changed to a list of functions.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
146
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
147 You can remove this hook yourself using `remove-hook'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
148
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
149 See also `add-local-hook' and `add-one-shot-hook'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
150 (or (boundp hook) (set hook nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
151 (or (default-boundp hook) (set-default hook nil))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
152 ;; If the hook value is a single function, turn it into a list.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
153 (let ((old (symbol-value hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
154 (if (or (not (listp old)) (eq (car old) 'lambda))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
155 (set hook (list old))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
156 (if (or local
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
157 ;; Detect the case where make-local-variable was used on a hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
158 ;; and do what we used to do.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
159 (and (local-variable-if-set-p hook (current-buffer)) ; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
160 (not (memq t (symbol-value hook)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
161 ;; Alter the local value only.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
162 (or (if (consp function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
163 (member function (symbol-value hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
164 (memq function (symbol-value hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
165 (set hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
166 (if append
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
167 (append (symbol-value hook) (list function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
168 (cons function (symbol-value hook)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
169 ;; Alter the global value (which is also the only value,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
170 ;; if the hook doesn't have a local value).
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
171 (or (if (consp function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
172 (member function (default-value hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
173 (memq function (default-value hook)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
174 (set-default hook
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
175 (if append
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
176 (append (default-value hook) (list function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
177 (cons function (default-value hook)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
178
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
179 (defun remove-hook (hook function &optional local)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
180 "Remove from the value of HOOK the function FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
181 HOOK should be a symbol, and FUNCTION may be any valid function. If
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
182 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
183 list of hooks to run in HOOK, then nothing is done. See `add-hook'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
184
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
185 The optional third argument, LOCAL, if non-nil, says to modify
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
186 the hook's buffer-local value rather than its default value.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
187 This makes no difference if the hook is not buffer-local.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
188 To make a hook variable buffer-local, always use
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
189 `make-local-hook', not `make-local-variable'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
190 (if (or (not (boundp hook)) ;unbound symbol, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
191 (not (default-boundp 'hook))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
192 (null (symbol-value hook)) ;value is nil, or
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
193 (null function)) ;function is nil, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
194 nil ;Do nothing.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
195 (flet ((hook-remove
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
196 (function hook-value)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
197 (flet ((hook-test
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
198 (fn hel)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
199 (or (equal fn hel)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
200 (and (symbolp hel)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
201 (equal fn
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
202 (get hel 'one-shot-hook-fun))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
203 (if (and (consp hook-value)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
204 (not (functionp hook-value)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
205 (if (member* function hook-value :test 'hook-test)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
206 (setq hook-value
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
207 (delete* function (copy-sequence hook-value)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
208 :test 'hook-test)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
209 (if (equal hook-value function)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
210 (setq hook-value nil)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
211 hook-value)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
212 (if (or local
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
213 ;; Detect the case where make-local-variable was used on a hook
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
214 ;; and do what we used to do.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
215 (and (local-variable-p hook (current-buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
216 (not (memq t (symbol-value hook)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
217 (set hook (hook-remove function (symbol-value hook)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
218 (set-default hook (hook-remove function (default-value hook)))))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
219
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
220 ;; XEmacs addition
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
221 ;; #### we need a coherent scheme for indicating compatibility info,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
222 ;; so that it can be programmatically retrieved.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
223 (defun add-local-hook (hook function &optional append)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
224 "Add to the local value of HOOK the function FUNCTION.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
225 This modifies only the buffer-local value for the hook (which is
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
226 automatically make buffer-local, if necessary), not its default value.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
227 FUNCTION is not added if already present.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
228 FUNCTION is added (if necessary) at the beginning of the hook list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
229 unless the optional argument APPEND is non-nil, in which case
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
230 FUNCTION is added at the end.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
231
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
232 HOOK should be a symbol, and FUNCTION may be any valid function. If
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
233 HOOK is void, it is first set to nil. If HOOK's value is a single
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
234 function, it is changed to a list of functions.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
235
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
236 You can remove this hook yourself using `remove-local-hook'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
237
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
238 See also `add-hook' and `make-local-hook'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
239 (make-local-hook hook)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
240 (add-hook hook function append t))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
241
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
242 ;; XEmacs addition
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
243 (defun remove-local-hook (hook function)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
244 "Remove from the local value of HOOK the function FUNCTION.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
245 This modifies only the buffer-local value for the hook, not its default
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
246 value. (Nothing happens if the hook is not buffer-local.)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
247 HOOK should be a symbol, and FUNCTION may be any valid function. If
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
248 FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
249 list of hooks to run in HOOK, then nothing is done. See `add-hook'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
250
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
251 See also `add-local-hook' and `make-local-hook'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
252 (if (local-variable-p hook (current-buffer))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
253 (remove-hook hook function t)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
254
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
255 (defun add-one-shot-hook (hook function &optional append local)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
256 "Add to the value of HOOK the one-shot function FUNCTION.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
257 FUNCTION will automatically be removed from the hook the first time
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
258 after it runs (whether to completion or to an error).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
259 FUNCTION is not added if already present.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
260 FUNCTION is added (if necessary) at the beginning of the hook list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
261 unless the optional argument APPEND is non-nil, in which case
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
262 FUNCTION is added at the end.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
263
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
264 HOOK should be a symbol, and FUNCTION may be any valid function. If
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
265 HOOK is void, it is first set to nil. If HOOK's value is a single
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
266 function, it is changed to a list of functions.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
267
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
268 You can remove this hook yourself using `remove-hook'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
269
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
270 See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
271 (let ((sym (gensym)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
272 (fset sym `(lambda (&rest args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
273 (unwind-protect
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
274 (apply ',function args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
275 (remove-hook ',hook ',sym ',local))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
276 (put sym 'one-shot-hook-fun function)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
277 (add-hook hook sym append local)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
278
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
279 (defun add-local-one-shot-hook (hook function &optional append)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
280 "Add to the local value of HOOK the one-shot function FUNCTION.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
281 FUNCTION will automatically be removed from the hook the first time
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
282 after it runs (whether to completion or to an error).
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
283 FUNCTION is not added if already present.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
284 FUNCTION is added (if necessary) at the beginning of the hook list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
285 unless the optional argument APPEND is non-nil, in which case
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
286 FUNCTION is added at the end.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
287
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
288 The optional fourth argument, LOCAL, if non-nil, says to modify
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
289 the hook's buffer-local value rather than its default value.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
290 This makes no difference if the hook is not buffer-local.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
291 To make a hook variable buffer-local, always use
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
292 `make-local-hook', not `make-local-variable'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
293
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
294 HOOK should be a symbol, and FUNCTION may be any valid function. If
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
295 HOOK is void, it is first set to nil. If HOOK's value is a single
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
296 function, it is changed to a list of functions.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
297
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
298 You can remove this hook yourself using `remove-local-hook'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
299
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
300 See also `add-hook', `add-local-hook', and `add-local-one-shot-hook'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
301 (make-local-hook hook)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
302 (add-one-shot-hook hook function append t))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
303
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
304 (defun add-to-list (list-var element)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
305 "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
306 The test for presence of ELEMENT is done with `equal'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
307 If you want to use `add-to-list' on a variable that is not defined
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
308 until a certain package is loaded, you should put the call to `add-to-list'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
309 into a hook function that will be run only after loading the package.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
310 `eval-after-load' provides one way to do this. In some cases
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
311 other hooks, such as major mode hooks, can do the job."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
312 (or (member element (symbol-value list-var))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
313 (set list-var (cons element (symbol-value list-var)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
314
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
315 ;; XEmacs additions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
316 ;; called by Fkill_buffer()
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
317 (defvar kill-buffer-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
318 "Function or functions to be called when a buffer is killed.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
319 The value of this variable may be buffer-local.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
320 The buffer about to be killed is current when this hook is run.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
321
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
322 ;; in C in FSFmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
323 (defvar kill-emacs-hook nil
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
324 "Function or functions to be called when `kill-emacs' is called,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
325 just before emacs is actually killed.")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
326
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
327 ;; not obsolete.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
328 ;; #### These are a bad idea, because the CL RPLACA and RPLACD
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
329 ;; return the cons cell, not the new CAR/CDR. -hniksic
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
330 ;; The proper definition would be:
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
331 ;; (defun rplaca (conscell newcar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
332 ;; (setcar conscell newcar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
333 ;; conscell)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
334 ;; ...and analogously for RPLACD.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
335 (define-function 'rplaca 'setcar)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
336 (define-function 'rplacd 'setcdr)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
337
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
338 (defun copy-symbol (symbol &optional copy-properties)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
339 "Return a new uninterned symbol with the same name as SYMBOL.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
340 If COPY-PROPERTIES is non-nil, the new symbol will have a copy of
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
341 SYMBOL's value, function, and property lists."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
342 (let ((new (make-symbol (symbol-name symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
343 (when copy-properties
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
344 ;; This will not copy SYMBOL's chain of forwarding objects, but
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
345 ;; I think that's OK. Callers should not expect such magic to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
346 ;; keep working in the copy in the first place.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
347 (and (boundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
348 (set new (symbol-value symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
349 (and (fboundp symbol)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
350 (fset new (symbol-function symbol)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
351 (setplist new (copy-list (symbol-plist symbol))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
352 new))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
353
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
354 (defun set-symbol-value-in-buffer (sym val buffer)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
355 "Set the value of SYM to VAL in BUFFER. Useful with buffer-local variables.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
356 If SYM has a buffer-local value in BUFFER, or will have one if set, this
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
357 function allows you to set the local value.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
358
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
359 NOTE: At some point, this will be moved into C and will be very fast."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
360 (with-current-buffer buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
361 (set sym val)))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
362
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
363 ;;;; String functions.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
364
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
365 ;; XEmacs
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
366 (defun replace-in-string (str regexp newtext &optional literal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
367 "Replace all matches in STR for REGEXP with NEWTEXT string,
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
368 and returns the new string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
369 Optional LITERAL non-nil means do a literal replacement.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
370 Otherwise treat `\\' in NEWTEXT as special:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
371 `\\&' in NEWTEXT means substitute original matched text.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
372 `\\N' means substitute what matched the Nth `\\(...\\)'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
373 If Nth parens didn't match, substitute nothing.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
374 `\\\\' means insert one `\\'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
375 `\\u' means upcase the next character.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
376 `\\l' means downcase the next character.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
377 `\\U' means begin upcasing all following characters.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
378 `\\L' means begin downcasing all following characters.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
379 `\\E' means terminate the effect of any `\\U' or `\\L'."
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
380 (check-argument-type 'stringp str)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
381 (check-argument-type 'stringp newtext)
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
382 (if (> (length str) 50)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
383 (with-temp-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
384 (insert str)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
385 (goto-char 1)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
386 (while (re-search-forward regexp nil t)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
387 (replace-match newtext t literal))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
388 (buffer-string))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
389 (let ((start 0) newstr)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
390 (while (string-match regexp str start)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
391 (setq newstr (replace-match newtext t literal str)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
392 start (+ (match-end 0) (- (length newstr) (length str)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
393 str newstr))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
394 str)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
395
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
396 (defun split-string (string &optional pattern)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
397 "Return a list of substrings of STRING which are separated by PATTERN.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
398 If PATTERN is omitted, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
399 (or pattern
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
400 (setq pattern "[ \f\t\n\r\v]+"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
401 (let (parts (start 0) (len (length string)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
402 (if (string-match pattern string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
403 (setq parts (cons (substring string 0 (match-beginning 0)) parts)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
404 start (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
405 (while (and (< start len)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
406 (string-match pattern string (if (> start (match-beginning 0))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
407 start
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
408 (1+ start))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
409 (setq parts (cons (substring string start (match-beginning 0)) parts)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
410 start (match-end 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
411 (nreverse (cons (substring string start) parts))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
412
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
413 ;; #### #### #### AAaargh! Must be in C, because it is used insanely
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
414 ;; early in the bootstrap process.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
415 ;(defun split-path (path)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
416 ; "Explode a search path into a list of strings.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
417 ;The path components are separated with the characters specified
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
418 ;with `path-separator'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
419 ; (while (or (not stringp path-separator)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
420 ; (/= (length path-separator) 1))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
421 ; (setq path-separator (signal 'error (list "\
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
422 ;`path-separator' should be set to a single-character string"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
423 ; path-separator))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
424 ; (split-string-by-char path (aref separator 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
425
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
426 (defmacro with-output-to-string (&rest forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
427 "Collect output to `standard-output' while evaluating FORMS and return
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
428 it as a string."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
429 ;; by "William G. Dubuque" <wgd@zurich.ai.mit.edu> w/ mods from Stig
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
430 `(with-current-buffer (get-buffer-create
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
431 (generate-new-buffer-name " *string-output*"))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
432 (setq buffer-read-only nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
433 (buffer-disable-undo (current-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
434 (erase-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
435 (let ((standard-output (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
436 ,@forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
437 (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
438 (buffer-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
439 (erase-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
440
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
441 (defmacro with-current-buffer (buffer &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
442 "Temporarily make BUFFER the current buffer and execute the forms in BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
443 The value returned is the value of the last form in BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
444 See also `with-temp-buffer'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
445 `(save-current-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
446 (set-buffer ,buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
447 ,@body))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
448
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
449 (defmacro with-temp-file (filename &rest forms)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
450 "Create a new buffer, evaluate FORMS there, and write the buffer to FILENAME.
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
451 The value of the last form in FORMS is returned, like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
452 See also `with-temp-buffer'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
453 (let ((temp-file (make-symbol "temp-file"))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
454 (temp-buffer (make-symbol "temp-buffer")))
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
455 `(let ((,temp-file ,filename)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
456 (,temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
457 (get-buffer-create (generate-new-buffer-name " *temp file*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
458 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
459 (prog1
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
460 (with-current-buffer ,temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
461 ,@forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
462 (with-current-buffer ,temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
463 (widen)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
464 (write-region (point-min) (point-max) ,temp-file nil 0)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
465 (and (buffer-name ,temp-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
466 (kill-buffer ,temp-buffer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
467
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
468 (defmacro with-temp-buffer (&rest forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
469 "Create a temporary buffer, and evaluate FORMS there like `progn'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
470 See also `with-temp-file' and `with-output-to-string'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
471 (let ((temp-buffer (make-symbol "temp-buffer")))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
472 `(let ((,temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
473 (get-buffer-create (generate-new-buffer-name " *temp*"))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
474 (unwind-protect
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
475 (with-current-buffer ,temp-buffer
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
476 ,@forms)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
477 (and (buffer-name ,temp-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
478 (kill-buffer ,temp-buffer))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
479
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
480 ;; Moved from mule-coding.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
481 (defmacro with-string-as-buffer-contents (str &rest body)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
482 "With the contents of the current buffer being STR, run BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
483 Returns the new contents of the buffer, as modified by BODY.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
484 The original current buffer is restored afterwards."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
485 `(with-temp-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
486 (insert ,str)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
487 ,@body
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
488 (buffer-string)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
489
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
490 (defun insert-face (string face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
491 "Insert STRING and highlight with FACE. Return the extent created."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
492 (let ((p (point)) ext)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
493 (insert string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
494 (setq ext (make-extent p (point)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
495 (set-extent-face ext face)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
496 ext))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
497
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
498 ;; not obsolete.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
499 (define-function 'string= 'string-equal)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
500 (define-function 'string< 'string-lessp)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
501 (define-function 'int-to-string 'number-to-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
502 (define-function 'string-to-int 'string-to-number)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
503
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
504 ;; These two names are a bit awkward, as they conflict with the normal
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
505 ;; foo-to-bar naming scheme, but CLtL2 has them, so they stay.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
506 (define-function 'char-int 'char-to-int)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
507 (define-function 'int-char 'int-to-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
508
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
509
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
510 ;; alist/plist functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
511 (defun plist-to-alist (plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
512 "Convert property list PLIST into the equivalent association-list form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
513 The alist is returned. This converts from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
514
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
515 \(a 1 b 2 c 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
516
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
517 into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
518
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
519 \((a . 1) (b . 2) (c . 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
520
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
521 The original plist is not modified. See also `destructive-plist-to-alist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
522 (let (alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
523 (while plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
524 (setq alist (cons (cons (car plist) (cadr plist)) alist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
525 (setq plist (cddr plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
526 (nreverse alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
527
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
528 (defun destructive-plist-to-alist (plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
529 "Convert property list PLIST into the equivalent association-list form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
530 The alist is returned. This converts from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
531
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
532 \(a 1 b 2 c 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
533
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
534 into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
535
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
536 \((a . 1) (b . 2) (c . 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
537
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
538 The original plist is destroyed in the process of constructing the alist.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
539 See also `plist-to-alist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
540 (let ((head plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
541 next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
542 (while plist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
543 ;; remember the next plist pair.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
544 (setq next (cddr plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
545 ;; make the cons holding the property value into the alist element.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
546 (setcdr (cdr plist) (cadr plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
547 (setcar (cdr plist) (car plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
548 ;; reattach into alist form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
549 (setcar plist (cdr plist))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
550 (setcdr plist next)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
551 (setq plist next))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
552 head))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
553
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
554 (defun alist-to-plist (alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
555 "Convert association list ALIST into the equivalent property-list form.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
556 The plist is returned. This converts from
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
557
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
558 \((a . 1) (b . 2) (c . 3))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
559
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
560 into
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
561
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
562 \(a 1 b 2 c 3)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
563
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
564 The original alist is not modified. See also `destructive-alist-to-plist'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
565 (let (plist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
566 (while alist
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
567 (let ((el (car alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
568 (setq plist (cons (cdr el) (cons (car el) plist))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
569 (setq alist (cdr alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
570 (nreverse plist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
571
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
572 ;; getf, remf in cl*.el.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
573
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
574 (defmacro putf (plist property value)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
575 "Add property PROPERTY to plist PLIST with value VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
576 Analogous to (setq PLIST (plist-put PLIST PROPERTY VALUE))."
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
577 `(setq ,plist (plist-put ,plist ,property ,value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
578
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
579 (defmacro laxputf (lax-plist property value)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
580 "Add property PROPERTY to lax plist LAX-PLIST with value VALUE.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
581 Analogous to (setq LAX-PLIST (lax-plist-put LAX-PLIST PROPERTY VALUE))."
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
582 `(setq ,lax-plist (lax-plist-put ,lax-plist ,property ,value)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
583
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
584 (defmacro laxremf (lax-plist property)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
585 "Remove property PROPERTY from lax plist LAX-PLIST.
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
586 Analogous to (setq LAX-PLIST (lax-plist-remprop LAX-PLIST PROPERTY))."
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
587 `(setq ,lax-plist (lax-plist-remprop ,lax-plist ,property)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
588
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
589 ;;; Error functions
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
590
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
591 (defun error (datum &rest args)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
592 "Signal a non-continuable error.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
593 DATUM should normally be an error symbol, i.e. a symbol defined using
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
594 `define-error'. ARGS will be made into a list, and DATUM and ARGS passed
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
595 as the two arguments to `signal', the most basic error handling function.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
596
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
597 This error is not continuable: you cannot continue execution after the
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
598 error using the debugger `r' command. See also `cerror'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
599
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
600 The correct semantics of ARGS varies from error to error, but for most
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
601 errors that need to be generated in Lisp code, the first argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
602 should be a string describing the *context* of the error (i.e. the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
603 exact operation being performed and what went wrong), and the remaining
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
604 arguments or \"frobs\" (most often, there is one) specify the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
605 offending object(s) and/or provide additional details such as the exact
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
606 error when a file error occurred, e.g.:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
607
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
608 -- the buffer in which an editing error occurred.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
609 -- an invalid value that was encountered. (In such cases, the string
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
610 should describe the purpose or \"semantics\" of the value [e.g. if the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
611 value is an argument to a function, the name of the argument; if the value
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
612 is the value corresponding to a keyword, the name of the keyword; if the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
613 value is supposed to be a list length, say this and say what the purpose
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
614 of the list is; etc.] as well as specifying why the value is invalid, if
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
615 that's not self-evident.)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
616 -- the file in which an error occurred. (In such cases, there should be a
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
617 second frob, probably a string, specifying the exact error that occurred.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
618 This does not occur in the string that precedes the first frob, because
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
619 that frob describes the exact operation that was happening.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
620
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
621 For historical compatibility, DATUM can also be a string. In this case,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
622 DATUM and ARGS are passed together as the arguments to `format', and then
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
623 an error is signalled using the error symbol `error' and formatted string.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
624 Although this usage of `error' is very common, it is deprecated because it
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
625 totally defeats the purpose of having structured errors. There is now
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
626 a rich set of defined errors you can use:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
627
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
628 error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
629 syntax-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
630 invalid-read-syntax
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
631 list-formation-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
632 malformed-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
633 malformed-property-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
634 circular-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
635 circular-property-list
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
636
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
637 invalid-argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
638 wrong-type-argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
639 args-out-of-range
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
640 wrong-number-of-arguments
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
641 invalid-function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
642 no-catch
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
643
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
644 invalid-state
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
645 void-function
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
646 cyclic-function-indirection
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
647 void-variable
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
648 cyclic-variable-indirection
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
649
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
650 invalid-operation
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
651 invalid-change
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
652 setting-constant
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
653 editing-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
654 beginning-of-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
655 end-of-buffer
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
656 buffer-read-only
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
657 io-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
658 end-of-file
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
659 arith-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
660 range-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
661 domain-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
662 singularity-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
663 overflow-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
664 underflow-error
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
665
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
666 The five most common errors you will probably use or base your new
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
667 errors off of are `syntax-error', `invalid-argument', `invalid-state',
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
668 `invalid-operation', and `invalid-change'. Note the semantic differences:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
669
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
670 -- `syntax-error' is for errors in complex structures: parsed strings, lists,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
671 and the like.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
672 -- `invalid-argument' is for errors in a simple value. Typically, the entire
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
673 value, not just one part of it, is wrong.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
674 -- `invalid-state' means that some settings have been changed in such a way
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
675 that their current state is unallowable. More and more, code is being
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
676 written more carefully, and catches the error when the settings are being
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
677 changed, rather than afterwards. This leads us to the next error:
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
678 -- `invalid-change' means that an attempt is being made to change some settings
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
679 into an invalid state. `invalid-change' is a type of `invalid-operation'.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
680 -- `invalid-operation' refers to all cases where code is trying to do something
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
681 that's disallowed. This includes file errors, buffer errors (e.g. running
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
682 off the end of a buffer), `invalid-change' as just mentioned, and
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
683 arithmetic errors.
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
684
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
685 See also `cerror', `signal', and `signal-error'."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
686 (while t (apply
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
687 'cerror datum args)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
688
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
689 (defun cerror (datum &rest args)
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
690 "Like `error' but signals a continuable error."
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
691 (cond ((stringp datum)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
692 (signal 'error (list (apply 'format datum args))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
693 ((defined-error-p datum)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
694 (signal datum args))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
695 (t
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
696 (error 'invalid-argument "datum not string or error symbol" datum))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
697
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
698 (defmacro check-argument-type (predicate argument)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
699 "Check that ARGUMENT satisfies PREDICATE.
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
700 This is a macro, and ARGUMENT is not evaluated. If ARGUMENT is an lvalue,
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
701 this function signals a continuable `wrong-type-argument' error until the
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
702 returned value satisfies PREDICATE, and assigns the returned value
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
703 to ARGUMENT. Otherwise, this function signals a non-continuable
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
704 `wrong-type-argument' error if the returned value does not satisfy PREDICATE."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
705 (if (symbolp argument)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
706 `(if (not (,(eval predicate) ,argument))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
707 (setq ,argument
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
708 (wrong-type-argument ,predicate ,argument)))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
709 `(if (not (,(eval predicate) ,argument))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
710 (signal-error 'wrong-type-argument (list ,predicate ,argument)))))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
711
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
712 (defun signal-error (error-symbol data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
713 "Signal a non-continuable error. Args are ERROR-SYMBOL, and associated DATA.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
714 An error symbol is a symbol defined using `define-error'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
715 DATA should be a list. Its elements are printed as part of the error message.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
716 If the signal is handled, DATA is made available to the handler.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
717 See also `signal', and the functions to handle errors: `condition-case'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
718 and `call-with-condition-handler'."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
719 (while t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
720 (signal error-symbol data)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
721
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
722 (defun define-error (error-sym doc-string &optional inherits-from)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
723 "Define a new error, denoted by ERROR-SYM.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
724 DOC-STRING is an informative message explaining the error, and will be
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
725 printed out when an unhandled error occurs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
726 ERROR-SYM is a sub-error of INHERITS-FROM (which defaults to `error').
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
727
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
728 \[`define-error' internally works by putting on ERROR-SYM an `error-message'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
729 property whose value is DOC-STRING, and an `error-conditions' property
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
730 that is a list of ERROR-SYM followed by each of its super-errors, up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
731 to and including `error'. You will sometimes see code that sets this up
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
732 directly rather than calling `define-error', but you should *not* do this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
733 yourself.]"
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
734 (check-argument-type 'symbolp error-sym)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
735 (check-argument-type 'stringp doc-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
736 (put error-sym 'error-message doc-string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
737 (or inherits-from (setq inherits-from 'error))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
738 (let ((conds (get inherits-from 'error-conditions)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
739 (or conds (signal-error 'error (list "Not an error symbol" error-sym)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
740 (put error-sym 'error-conditions (cons error-sym conds))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
741
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
742 (defun defined-error-p (sym)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
743 "Returns non-nil if SYM names a currently-defined error."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
744 (and (symbolp sym) (not (null (get sym 'error-conditions)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
745
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
746 ;;;; Miscellanea.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
747
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
748 ;; This is now in C.
444
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
749 ;(defun buffer-substring-no-properties (start end)
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
750 ; "Return the text from START to END, without text properties, as a string."
576fb035e263 Import from CVS: tag r21-2-37
cvs
parents: 442
diff changeset
751 ; (let ((string (buffer-substring start end)))
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
752 ; (set-text-properties 0 (length string) nil string)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
753 ; string))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
754
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
755 (defun get-buffer-window-list (&optional buffer minibuf frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
756 "Return windows currently displaying BUFFER, or nil if none.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
757 BUFFER defaults to the current buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
758 See `walk-windows' for the meaning of MINIBUF and FRAME."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
759 (cond ((null buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
760 (setq buffer (current-buffer)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
761 ((not (bufferp buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
762 (setq buffer (get-buffer buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
763 (let (windows)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
764 (walk-windows (lambda (window)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
765 (if (eq (window-buffer window) buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
766 (push window windows)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
767 minibuf frame)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
768 windows))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
769
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
770 (defun ignore (&rest ignore)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
771 "Do nothing and return nil.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
772 This function accepts any number of arguments, but ignores them."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
773 (interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
774 nil)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
775
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
776 (define-function 'eval-in-buffer 'with-current-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
777 (make-obsolete 'eval-in-buffer 'with-current-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
778
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
779 ;;; The real defn is in abbrev.el but some early callers
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
780 ;;; (eg lisp-mode-abbrev-table) want this before abbrev.el is loaded...
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
781
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
782 (if (not (fboundp 'define-abbrev-table))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
783 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
784 (setq abbrev-table-name-list '())
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
785 (fset 'define-abbrev-table (function (lambda (name defs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
786 ;; These are fixed-up when abbrev.el loads.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
787 (setq abbrev-table-name-list
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
788 (cons (cons name defs)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
789 abbrev-table-name-list)))))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
790
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
791 ;;; `functionp' has been moved into C.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
792
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
793 ;;(defun functionp (object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
794 ;; "Non-nil if OBJECT can be called as a function."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
795 ;; (or (and (symbolp object) (fboundp object))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
796 ;; (subrp object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
797 ;; (compiled-function-p object)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
798 ;; (eq (car-safe object) 'lambda)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
799
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
800
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
801
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
802 (defun function-interactive (function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
803 "Return the interactive specification of FUNCTION.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
804 FUNCTION can be any funcallable object.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
805 The specification will be returned as the list of the symbol `interactive'
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
806 and the specs.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
807 If FUNCTION is not interactive, nil will be returned."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
808 (setq function (indirect-function function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
809 (cond ((compiled-function-p function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
810 (compiled-function-interactive function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
811 ((subrp function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
812 (subr-interactive function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
813 ((eq (car-safe function) 'lambda)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
814 (let ((spec (if (stringp (nth 2 function))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
815 (nth 3 function)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
816 (nth 2 function))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
817 (and (eq (car-safe spec) 'interactive)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
818 spec)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
819 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
820 (error "Non-funcallable object: %s" function))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
821
442
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
822 (defun function-allows-args (function n)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
823 "Return whether FUNCTION can be called with N arguments."
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
824 (and (<= (function-min-args function) n)
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
825 (or (null (function-max-args function))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
826 (<= n (function-max-args function)))))
abe6d1db359e Import from CVS: tag r21-2-36
cvs
parents: 428
diff changeset
827
428
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
828 ;; This function used to be an alias to `buffer-substring', except
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
829 ;; that FSF Emacs 20.4 added a BUFFER argument in an incompatible way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
830 ;; The new FSF's semantics makes more sense, but we try to support
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
831 ;; both for backward compatibility.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
832 (defun buffer-string (&optional buffer old-end old-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
833 "Return the contents of the current buffer as a string.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
834 If narrowing is in effect, this function returns only the visible part
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
835 of the buffer.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
836
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
837 If BUFFER is specified, the contents of that buffer are returned.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
838
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
839 The arguments OLD-END and OLD-BUFFER are supported for backward
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
840 compatibility with pre-21.2 XEmacsen times when arguments to this
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
841 function were (buffer-string &optional START END BUFFER)."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
842 (cond
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
843 ((or (stringp buffer) (bufferp buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
844 ;; Most definitely the new way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
845 (buffer-substring nil nil buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
846 ((or (stringp old-buffer) (bufferp old-buffer)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
847 (natnump buffer) (natnump old-end))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
848 ;; Definitely the old way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
849 (buffer-substring buffer old-end old-buffer))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
850 (t
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
851 ;; Probably the old way.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
852 (buffer-substring buffer old-end old-buffer))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
853
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
854 ;; This was not present before. I think Jamie had some objections
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
855 ;; to this, so I'm leaving this undefined for now. --ben
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
856
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
857 ;;; The objection is this: there is more than one way to load the same file.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
858 ;;; "foo", "foo.elc", "foo.el", and "/some/path/foo.elc" are all different
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
859 ;;; ways to load the exact same code. `eval-after-load' is too stupid to
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
860 ;;; deal with this sort of thing. If this sort of feature is desired, then
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
861 ;;; it should work off of a hook on `provide'. Features are unique and
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
862 ;;; the arguments to (load) are not. --Stig
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
863
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
864 ;; We provide this for FSFmacs compatibility, at least until we devise
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
865 ;; something better.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
866
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
867 ;;;; Specifying things to do after certain files are loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
868
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
869 (defun eval-after-load (file form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
870 "Arrange that, if FILE is ever loaded, FORM will be run at that time.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
871 This makes or adds to an entry on `after-load-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
872 If FILE is already loaded, evaluate FORM right now.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
873 It does nothing if FORM is already on the list for FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
874 FILE should be the name of a library, with no directory name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
875 ;; Make sure there is an element for FILE.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
876 (or (assoc file after-load-alist)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
877 (setq after-load-alist (cons (list file) after-load-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
878 ;; Add FORM to the element if it isn't there.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
879 (let ((elt (assoc file after-load-alist)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
880 (or (member form (cdr elt))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
881 (progn
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
882 (nconc elt (list form))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
883 ;; If the file has been loaded already, run FORM right away.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
884 (and (assoc file load-history)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
885 (eval form)))))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
886 form)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
887 (make-compatible 'eval-after-load "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
888
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
889 (defun eval-next-after-load (file)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
890 "Read the following input sexp, and run it whenever FILE is loaded.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
891 This makes or adds to an entry on `after-load-alist'.
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
892 FILE should be the name of a library, with no directory name."
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
893 (eval-after-load file (read)))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
894 (make-compatible 'eval-next-after-load "")
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
895
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
896 ; alternate names (not obsolete)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
897 (if (not (fboundp 'mod)) (define-function 'mod '%))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
898 (define-function 'move-marker 'set-marker)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
899 (define-function 'beep 'ding) ; preserve lingual purity
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
900 (define-function 'indent-to-column 'indent-to)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
901 (define-function 'backward-delete-char 'delete-backward-char)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
902 (define-function 'search-forward-regexp (symbol-function 're-search-forward))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
903 (define-function 'search-backward-regexp (symbol-function 're-search-backward))
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
904 (define-function 'remove-directory 'delete-directory)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
905 (define-function 'set-match-data 'store-match-data)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
906 (define-function 'send-string-to-terminal 'external-debugging-output)
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
907
3ecd8885ac67 Import from CVS: tag r21-2-22
cvs
parents:
diff changeset
908 ;;; subr.el ends here