localhook.el

   1 ;;; localhook.el --- local hook variable support in emacs-lisp.
   2
   3 ;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc.
   4 ;; Copyright (C) 1999 Shuhei KOBAYASHI
   5
   6 ;; Author: Shuhei KOBAYASHI <shuhei@aqua.ocn.ne.jp>
   7 ;; Keywords: compatibility
   8
   9 ;; This file is part of APEL (A Portable Emacs Library).
  10
  11 ;; This program is free software; you can redistribute it and/or
  12 ;; modify it under the terms of the GNU General Public License as
  13 ;; published by the Free Software Foundation; either version 2, or (at
  14 ;; your option) any later version.
  15
  16 ;; This program is distributed in the hope that it will be useful, but
  17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19 ;; General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with this program; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; This file (re)defines the following functions.
  29 ;; These functions support local hook feature in emacs-lisp level.
  30 ;;
  31 ;;      add-hook, remove-hook, make-local-hook,
  32 ;;      run-hooks, run-hook-with-args,
  33 ;;      run-hook-with-args-until-success, and
  34 ;;      run-hook-with-args-until-failure.
  35 ;;
  36 ;; The following functions which do not exist in 19.28 are used in the
  37 ;; original definitions of add-hook, remove-hook, and make-local-hook.
  38 ;;
  39 ;;      local-variable-p, and local-variable-if-set-p.
  40 ;;
  41 ;; In this file, these functions are replaced with mock versions.
  42 ;;
  43 ;; In addition, the following functions which do not exist in v18 are used.
  44 ;;
  45 ;;      default-boundp, byte-code-function-p, functionp, member, and delete.
  46 ;;
  47 ;; These functions are provided by poe-18.el.
  48
  49 ;; For historians:
  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 ;;      (Needs XEmacs info: it seems XEmacs 21 is synched up with 19.30.)
  60
  61 ;;; Code:
  62
  63 (provide 'localhook)                    ; beware of circular dependency.
  64 (require 'poe)                          ; this file is loaded from poe.el.
  65
  66 ;;; These two functions are not complete, but work enough for our purpose.
  67 ;;
  68 ;; (defun local-variable-p (variable &optional buffer)
  69 ;;   "Non-nil if VARIABLE has a local binding in buffer BUFFER.
  70 ;; BUFFER defaults to the current buffer."
  71 ;;   (and (or (assq variable (buffer-local-variables buffer)) ; local and bound.
  72 ;;         (memq variable (buffer-local-variables buffer))); local but void.
  73 ;;        ;; docstring is ambiguous; 20.3 returns bool value.
  74 ;;        t))
  75 ;;
  76 ;; (defun local-variable-if-set-p (variable &optional buffer)
  77 ;;   "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there.
  78 ;; BUFFER defaults to the current buffer."
  79 ;;   (and (or (assq variable (buffer-local-variables buffer)) ; local and bound.
  80 ;;         (memq variable (buffer-local-variables buffer))); local but void.
  81 ;;        ;; docstring is ambiguous; 20.3 returns bool value.
  82 ;;        t))
  83
  84 ;;; @ Hook manipulation functions.
  85 ;;;
  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 replaced.)
  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 \f
 204
 205 ;;; @ Hook execution functions.
 206 ;;;
 207
 208 (defun run-hook-with-args-internal (hook args cond)
 209 ;;   "Run HOOK with the specified arguments ARGS.
 210 ;; HOOK should be a symbol, a hook variable.  Its value should be a list of
 211 ;; functions.  We call those functions, one by one, passing arguments ARGS
 212 ;; to each of them, until specified COND is satisfied.  If COND is nil, we
 213 ;; call those functions until one of them returns a non-nil value, and then
 214 ;; we return that value.  If COND is t, we call those functions until one
 215 ;; of them returns nil, and then we return nil.  If COND is not nil and not
 216 ;; t, we call all the functions."
 217   (if (not (boundp hook))
 218       ;; hook is void.
 219       (not cond)
 220     (let* ((functions (symbol-value hook))
 221            (ret (eq cond t))
 222            (all (and cond (not ret)))
 223            function)
 224       (if (functionp functions)
 225           ;; hook is just a function.
 226           (apply functions args)
 227         ;; hook is nil or a list of functions.
 228         (while (and functions
 229                     (or all             ; to-completion
 230                         (if cond
 231                             ret         ; until-failure
 232                           (null ret)))) ; until-success
 233           (setq function (car functions)
 234                 functions(cdr functions))
 235           (if (eq function t)
 236               ;; this hook has a local binding.
 237               ;; we must run the global binding too.
 238               (let ((globals (default-value hook))
 239                     global)
 240                 (if (functionp globals)
 241                     (setq ret (apply globals args))
 242                   (while (and globals
 243                               (or all
 244                                   (if cond
 245                                       ret
 246                                     (null ret))))
 247                     (setq global (car globals)
 248                           globals(cdr globals))
 249                     (or (eq global t)   ; t should not occur.
 250                         (setq ret (apply global args))))))
 251             (setq ret (apply function args))))
 252         ret))))
 253
 254 ;;; The following four functions are direct translation of their
 255 ;;; C definitions of emacs-20.3/src/eval.c.
 256 (defun run-hooks (&rest hooks)
 257   "Run each hook in HOOKS.  Major mode functions use this.
 258 Each argument should be a symbol, a hook variable.
 259 These symbols are processed in the order specified.
 260 If a hook symbol has a non-nil value, that value may be a function
 261 or a list of functions to be called to run the hook.
 262 If the value is a function, it is called with no arguments.
 263 If it is a list, the elements are called, in order, with no arguments.
 264
 265 To make a hook variable buffer-local, use `make-local-hook',
 266 not `make-local-variable'."
 267   (while hooks
 268     (run-hook-with-args-internal (car hooks) nil 'to-completion)
 269     (setq hooks (cdr hooks))))
 270
 271 (defun run-hook-with-args (hook &rest args)
 272   "Run HOOK with the specified arguments ARGS.
 273 HOOK should be a symbol, a hook variable.  If HOOK has a non-nil
 274 value, that value may be a function or a list of functions to be
 275 called to run the hook.  If the value is a function, it is called with
 276 the given arguments and its return value is returned.  If it is a list
 277 of functions, those functions are called, in order,
 278 with the given arguments ARGS.
 279 It is best not to depend on the value return by `run-hook-with-args',
 280 as that may change.
 281
 282 To make a hook variable buffer-local, use `make-local-hook',
 283 not `make-local-variable'."
 284   (run-hook-with-args-internal hook args 'to-completion))
 285
 286 (defun run-hook-with-args-until-success (hook &rest args)
 287   "Run HOOK with the specified arguments ARGS.
 288 HOOK should be a symbol, a hook variable.  Its value should
 289 be a list of functions.  We call those functions, one by one,
 290 passing arguments ARGS to each of them, until one of them
 291 returns a non-nil value.  Then we return that value.
 292 If all the functions return nil, we return nil.
 293
 294 To make a hook variable buffer-local, use `make-local-hook',
 295 not `make-local-variable'."
 296   (run-hook-with-args-internal hook args nil))
 297
 298 (defun run-hook-with-args-until-failure (hook &rest args)
 299   "Run HOOK with the specified arguments ARGS.
 300 HOOK should be a symbol, a hook variable.  Its value should
 301 be a list of functions.  We call those functions, one by one,
 302 passing arguments ARGS to each of them, until one of them
 303 returns nil.  Then we return nil.
 304 If all the functions return non-nil, we return non-nil.
 305
 306 To make a hook variable buffer-local, use `make-local-hook',
 307 not `make-local-variable'."
 308   (run-hook-with-args-internal hook args t))
 309
 310 ;;; @ End.
 311 ;;;
 312
 313 ;;; localhook.el ends here.