1 | ;;; localhook.el --- local hook variable support in emacs-lisp. |
---|
2 | |
---|
3 | ;; Copyright (C) 1985,86,92,94,95,1999 Free Software Foundation, Inc. |
---|
4 | |
---|
5 | ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp> |
---|
6 | ;; Keywords: compatibility |
---|
7 | |
---|
8 | ;; This file is part of APEL (A Portable Emacs Library). |
---|
9 | |
---|
10 | ;; This program is free software; you can redistribute it and/or |
---|
11 | ;; modify it under the terms of the GNU General Public License as |
---|
12 | ;; published by the Free Software Foundation; either version 2, or (at |
---|
13 | ;; your option) any later version. |
---|
14 | |
---|
15 | ;; This program is distributed in the hope that it will be useful, but |
---|
16 | ;; WITHOUT ANY WARRANTY; without even the implied warranty of |
---|
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
---|
18 | ;; General Public License for more details. |
---|
19 | |
---|
20 | ;; You should have received a copy of the GNU General Public License |
---|
21 | ;; along with this program; see the file COPYING. If not, write to |
---|
22 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
---|
23 | ;; Boston, MA 02111-1307, USA. |
---|
24 | |
---|
25 | ;;; Commentary: |
---|
26 | |
---|
27 | ;; This file (re)defines the following functions. |
---|
28 | ;; These functions support local hook feature in emacs-lisp level. |
---|
29 | ;; |
---|
30 | ;; add-hook, remove-hook, make-local-hook, |
---|
31 | ;; run-hooks, run-hook-with-args, |
---|
32 | ;; run-hook-with-args-until-success, and |
---|
33 | ;; run-hook-with-args-until-failure. |
---|
34 | |
---|
35 | ;; The following functions which do not exist in 19.28 are used in the |
---|
36 | ;; original definitions of add-hook, remove-hook, and make-local-hook. |
---|
37 | ;; |
---|
38 | ;; local-variable-p, and local-variable-if-set-p. |
---|
39 | ;; |
---|
40 | ;; In this file, these functions are replaced with mock versions. |
---|
41 | |
---|
42 | ;; In addition, the following functions which do not exist in v18 are used. |
---|
43 | ;; |
---|
44 | ;; default-boundp, byte-code-function-p, functionp, member, and delete. |
---|
45 | ;; |
---|
46 | ;; These functions are provided by poe-18.el. |
---|
47 | |
---|
48 | ;; For historians: |
---|
49 | ;; |
---|
50 | ;; `add-hook' and `remove-hook' were introduced in v19. |
---|
51 | ;; |
---|
52 | ;; Local hook feature and `make-local-hook' were introduced in 19.29. |
---|
53 | ;; |
---|
54 | ;; `run-hooks' exists in v17. |
---|
55 | ;; `run-hook-with-args' was introduced in 19.23 as a lisp function. |
---|
56 | ;; Two variants of `run-hook-with-args' were introduced in 19.29 as |
---|
57 | ;; lisp functions. `run-hook' family became C primitives in 19.30. |
---|
58 | |
---|
59 | ;;; Code: |
---|
60 | |
---|
61 | ;; beware of circular dependency. |
---|
62 | (require 'product) |
---|
63 | (product-provide (provide 'localhook) (require 'apel-ver)) |
---|
64 | |
---|
65 | (require 'poe) ; this file is loaded from poe.el. |
---|
66 | |
---|
67 | ;; These two functions are not complete, but work enough for our purpose. |
---|
68 | ;; |
---|
69 | ;; (defun local-variable-p (variable &optional buffer) |
---|
70 | ;; "Non-nil if VARIABLE has a local binding in buffer BUFFER. |
---|
71 | ;; BUFFER defaults to the current buffer." |
---|
72 | ;; (and (or (assq variable (buffer-local-variables buffer)) ; local and bound. |
---|
73 | ;; (memq variable (buffer-local-variables buffer))); local but void. |
---|
74 | ;; ;; docstring is ambiguous; 20.3 returns bool value. |
---|
75 | ;; t)) |
---|
76 | ;; |
---|
77 | ;; (defun local-variable-if-set-p (variable &optional buffer) |
---|
78 | ;; "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. |
---|
79 | ;; BUFFER defaults to the current buffer." |
---|
80 | ;; (and (or (assq variable (buffer-local-variables buffer)) ; local and bound. |
---|
81 | ;; (memq variable (buffer-local-variables buffer))); local but void. |
---|
82 | ;; ;; docstring is ambiguous; 20.3 returns bool value. |
---|
83 | ;; t)) |
---|
84 | |
---|
85 | ;;; Hook manipulation functions. |
---|
86 | |
---|
87 | ;; The following three functions are imported from emacs-20.3/lisp/subr.el. |
---|
88 | ;; (local-variable-p, and local-variable-if-set-p are expanded.) |
---|
89 | (defun make-local-hook (hook) |
---|
90 | "Make the hook HOOK local to the current buffer. |
---|
91 | The return value is HOOK. |
---|
92 | |
---|
93 | When a hook is local, its local and global values |
---|
94 | work in concert: running the hook actually runs all the hook |
---|
95 | functions listed in *either* the local value *or* the global value |
---|
96 | of the hook variable. |
---|
97 | |
---|
98 | This function works by making `t' a member of the buffer-local value, |
---|
99 | which acts as a flag to run the hook functions in the default value as |
---|
100 | well. This works for all normal hooks, but does not work for most |
---|
101 | non-normal hooks yet. We will be changing the callers of non-normal |
---|
102 | hooks so that they can handle localness; this has to be done one by |
---|
103 | one. |
---|
104 | |
---|
105 | This function does nothing if HOOK is already local in the current |
---|
106 | buffer. |
---|
107 | |
---|
108 | Do not use `make-local-variable' to make a hook variable buffer-local." |
---|
109 | (if ;; (local-variable-p hook) |
---|
110 | (or (assq hook (buffer-local-variables)) ; local and bound. |
---|
111 | (memq hook (buffer-local-variables))); local but void. |
---|
112 | nil |
---|
113 | (or (boundp hook) (set hook nil)) |
---|
114 | (make-local-variable hook) |
---|
115 | (set hook (list t))) |
---|
116 | hook) |
---|
117 | |
---|
118 | (defun add-hook (hook function &optional append local) |
---|
119 | "Add to the value of HOOK the function FUNCTION. |
---|
120 | FUNCTION is not added if already present. |
---|
121 | FUNCTION is added (if necessary) at the beginning of the hook list |
---|
122 | unless the optional argument APPEND is non-nil, in which case |
---|
123 | FUNCTION is added at the end. |
---|
124 | |
---|
125 | The optional fourth argument, LOCAL, if non-nil, says to modify |
---|
126 | the hook's buffer-local value rather than its default value. |
---|
127 | This makes no difference if the hook is not buffer-local. |
---|
128 | To make a hook variable buffer-local, always use |
---|
129 | `make-local-hook', not `make-local-variable'. |
---|
130 | |
---|
131 | HOOK should be a symbol, and FUNCTION may be any valid function. If |
---|
132 | HOOK is void, it is first set to nil. If HOOK's value is a single |
---|
133 | function, it is changed to a list of functions." |
---|
134 | (or (boundp hook) (set hook nil)) |
---|
135 | (or (default-boundp hook) (set-default hook nil)) |
---|
136 | ;; If the hook value is a single function, turn it into a list. |
---|
137 | (let ((old (symbol-value hook))) |
---|
138 | (if (or (not (listp old)) (eq (car old) 'lambda)) |
---|
139 | (set hook (list old)))) |
---|
140 | (if (or local |
---|
141 | ;; Detect the case where make-local-variable was used on a hook |
---|
142 | ;; and do what we used to do. |
---|
143 | (and ;; (local-variable-if-set-p hook) |
---|
144 | (or (assq hook (buffer-local-variables)) ; local and bound. |
---|
145 | (memq hook (buffer-local-variables))); local but void. |
---|
146 | (not (memq t (symbol-value hook))))) |
---|
147 | ;; Alter the local value only. |
---|
148 | (or (if (or (consp function) (byte-code-function-p function)) |
---|
149 | (member function (symbol-value hook)) |
---|
150 | (memq function (symbol-value hook))) |
---|
151 | (set hook |
---|
152 | (if append |
---|
153 | (append (symbol-value hook) (list function)) |
---|
154 | (cons function (symbol-value hook))))) |
---|
155 | ;; Alter the global value (which is also the only value, |
---|
156 | ;; if the hook doesn't have a local value). |
---|
157 | (or (if (or (consp function) (byte-code-function-p function)) |
---|
158 | (member function (default-value hook)) |
---|
159 | (memq function (default-value hook))) |
---|
160 | (set-default hook |
---|
161 | (if append |
---|
162 | (append (default-value hook) (list function)) |
---|
163 | (cons function (default-value hook))))))) |
---|
164 | |
---|
165 | (defun remove-hook (hook function &optional local) |
---|
166 | "Remove from the value of HOOK the function FUNCTION. |
---|
167 | HOOK should be a symbol, and FUNCTION may be any valid function. If |
---|
168 | FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the |
---|
169 | list of hooks to run in HOOK, then nothing is done. See `add-hook'. |
---|
170 | |
---|
171 | The optional third argument, LOCAL, if non-nil, says to modify |
---|
172 | the hook's buffer-local value rather than its default value. |
---|
173 | This makes no difference if the hook is not buffer-local. |
---|
174 | To make a hook variable buffer-local, always use |
---|
175 | `make-local-hook', not `make-local-variable'." |
---|
176 | (if (or (not (boundp hook)) ;unbound symbol, or |
---|
177 | (not (default-boundp hook)) |
---|
178 | (null (symbol-value hook)) ;value is nil, or |
---|
179 | (null function)) ;function is nil, then |
---|
180 | nil ;Do nothing. |
---|
181 | (if (or local |
---|
182 | ;; Detect the case where make-local-variable was used on a hook |
---|
183 | ;; and do what we used to do. |
---|
184 | (and ;; (local-variable-p hook) |
---|
185 | (or (assq hook (buffer-local-variables)) ; local and bound. |
---|
186 | (memq hook (buffer-local-variables))); local but void. |
---|
187 | (consp (symbol-value hook)) |
---|
188 | (not (memq t (symbol-value hook))))) |
---|
189 | (let ((hook-value (symbol-value hook))) |
---|
190 | (if (consp hook-value) |
---|
191 | (if (member function hook-value) |
---|
192 | (setq hook-value (delete function (copy-sequence hook-value)))) |
---|
193 | (if (equal hook-value function) |
---|
194 | (setq hook-value nil))) |
---|
195 | (set hook hook-value)) |
---|
196 | (let ((hook-value (default-value hook))) |
---|
197 | (if (and (consp hook-value) (not (functionp hook-value))) |
---|
198 | (if (member function hook-value) |
---|
199 | (setq hook-value (delete function (copy-sequence hook-value)))) |
---|
200 | (if (equal hook-value function) |
---|
201 | (setq hook-value nil))) |
---|
202 | (set-default hook hook-value))))) |
---|
203 | |
---|
204 | ;;; Hook execution functions. |
---|
205 | |
---|
206 | (defun run-hook-with-args-internal (hook args cond) |
---|
207 | "Run HOOK with the specified arguments ARGS. |
---|
208 | HOOK should be a symbol, a hook variable. Its value should be a list of |
---|
209 | functions. We call those functions, one by one, passing arguments ARGS |
---|
210 | to each of them, until specified COND is satisfied. If COND is nil, we |
---|
211 | call those functions until one of them returns a non-nil value, and then |
---|
212 | we return that value. If COND is t, we call those functions until one |
---|
213 | of them returns nil, and then we return nil. If COND is not nil and not |
---|
214 | t, we call all the functions." |
---|
215 | (if (not (boundp hook)) |
---|
216 | ;; hook is void. |
---|
217 | (not cond) |
---|
218 | (let* ((functions (symbol-value hook)) |
---|
219 | (ret (eq cond t)) |
---|
220 | (all (and cond (not ret))) |
---|
221 | function) |
---|
222 | (if (functionp functions) |
---|
223 | ;; hook is just a function. |
---|
224 | (apply functions args) |
---|
225 | ;; hook is nil or a list of functions. |
---|
226 | (while (and functions |
---|
227 | (or all ; to-completion |
---|
228 | (if cond |
---|
229 | ret ; until-failure |
---|
230 | (null ret)))) ; until-success |
---|
231 | (setq function (car functions) |
---|
232 | functions(cdr functions)) |
---|
233 | (if (eq function t) |
---|
234 | ;; this hook has a local binding. |
---|
235 | ;; we must run the global binding too. |
---|
236 | (let ((globals (default-value hook)) |
---|
237 | global) |
---|
238 | (if (functionp globals) |
---|
239 | (setq ret (apply globals args)) |
---|
240 | (while (and globals |
---|
241 | (or all |
---|
242 | (if cond |
---|
243 | ret |
---|
244 | (null ret)))) |
---|
245 | (setq global (car globals) |
---|
246 | globals(cdr globals)) |
---|
247 | (or (eq global t) ; t should not occur. |
---|
248 | (setq ret (apply global args)))))) |
---|
249 | (setq ret (apply function args)))) |
---|
250 | ret)))) |
---|
251 | |
---|
252 | ;; The following four functions are direct translation of their |
---|
253 | ;; C definitions in emacs-20.3/src/eval.c. |
---|
254 | (defun run-hooks (&rest hooks) |
---|
255 | "Run each hook in HOOKS. Major mode functions use this. |
---|
256 | Each argument should be a symbol, a hook variable. |
---|
257 | These symbols are processed in the order specified. |
---|
258 | If a hook symbol has a non-nil value, that value may be a function |
---|
259 | or a list of functions to be called to run the hook. |
---|
260 | If the value is a function, it is called with no arguments. |
---|
261 | If it is a list, the elements are called, in order, with no arguments. |
---|
262 | |
---|
263 | To make a hook variable buffer-local, use `make-local-hook', |
---|
264 | not `make-local-variable'." |
---|
265 | (while hooks |
---|
266 | (run-hook-with-args-internal (car hooks) nil 'to-completion) |
---|
267 | (setq hooks (cdr hooks)))) |
---|
268 | |
---|
269 | (defun run-hook-with-args (hook &rest args) |
---|
270 | "Run HOOK with the specified arguments ARGS. |
---|
271 | HOOK should be a symbol, a hook variable. If HOOK has a non-nil |
---|
272 | value, that value may be a function or a list of functions to be |
---|
273 | called to run the hook. If the value is a function, it is called with |
---|
274 | the given arguments and its return value is returned. If it is a list |
---|
275 | of functions, those functions are called, in order, |
---|
276 | with the given arguments ARGS. |
---|
277 | It is best not to depend on the value return by `run-hook-with-args', |
---|
278 | as that may change. |
---|
279 | |
---|
280 | To make a hook variable buffer-local, use `make-local-hook', |
---|
281 | not `make-local-variable'." |
---|
282 | (run-hook-with-args-internal hook args 'to-completion)) |
---|
283 | |
---|
284 | (defun run-hook-with-args-until-success (hook &rest args) |
---|
285 | "Run HOOK with the specified arguments ARGS. |
---|
286 | HOOK should be a symbol, a hook variable. Its value should |
---|
287 | be a list of functions. We call those functions, one by one, |
---|
288 | passing arguments ARGS to each of them, until one of them |
---|
289 | returns a non-nil value. Then we return that value. |
---|
290 | If all the functions return nil, we return nil. |
---|
291 | |
---|
292 | To make a hook variable buffer-local, use `make-local-hook', |
---|
293 | not `make-local-variable'." |
---|
294 | (run-hook-with-args-internal hook args nil)) |
---|
295 | |
---|
296 | (defun run-hook-with-args-until-failure (hook &rest args) |
---|
297 | "Run HOOK with the specified arguments ARGS. |
---|
298 | HOOK should be a symbol, a hook variable. Its value should |
---|
299 | be a list of functions. We call those functions, one by one, |
---|
300 | passing arguments ARGS to each of them, until one of them |
---|
301 | returns nil. Then we return nil. |
---|
302 | If all the functions return non-nil, we return non-nil. |
---|
303 | |
---|
304 | To make a hook variable buffer-local, use `make-local-hook', |
---|
305 | not `make-local-variable'." |
---|
306 | (run-hook-with-args-internal hook args t)) |
---|
307 | |
---|
308 | ;;; localhook.el ends here |
---|