From: shuhei-k Date: Sun, 16 May 1999 06:30:38 +0000 (+0000) Subject: New file; local hook variable support. X-Git-Tag: apel-9_19~43 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=3174f8e5fecbc06605891878aa569e3a933bb360;p=elisp%2Fapel.git New file; local hook variable support. --- diff --git a/localhook.el b/localhook.el new file mode 100644 index 0000000..d0b392c --- /dev/null +++ b/localhook.el @@ -0,0 +1,314 @@ +;;; localhook.el --- local hook variable support in emacs-lisp. + +;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc. +;; Copyright (C) 1999 Shuhei KOBAYASHI + +;; Author: Shuhei KOBAYASHI +;; Keywords: compatibility + +;; This file is part of APEL (A Portable Emacs Library). + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation; either version 2, or (at +;; your option) any later version. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This file (re)defines the following functions. +;; These functions support local hook feature in emacs-lisp level. +;; +;; add-hook, remove-hook, make-local-hook, +;; run-hooks, run-hook-with-args, +;; run-hook-with-args-until-success, and +;; run-hook-with-args-until-failure. +;; +;; The following functions which do not exist in 19.28 are used in the +;; original definitions of add-hook, remove-hook, and make-local-hook. +;; +;; local-variable-p, and local-variable-if-set-p. +;; +;; In this file, these functions are replaced with mock versions. +;; +;; In addition, the following functions which do not exist in v18 are used. +;; +;; default-boundp, byte-code-function-p, functionp, member, and delete. +;; +;; These functions are provided by poe-18.el. + +;; For historians: +;; `add-hook' and `remove-hook' were introduced in v19. +;; +;; Local hook feature and `make-local-hook' were introduced in 19.29. +;; +;; `run-hooks' exists in v17. +;; `run-hook-with-args' was introduced in 19.23 as a lisp function. +;; Two variants of `run-hook-with-args' were introduced in 19.29 as +;; lisp functions. `run-hook' family became C primitives in 19.30. +;; +;; (Needs XEmacs info: it seems XEmacs 21 is synched up with 19.30.) + +;;; Code: + +(require 'poe) + +;;; These two functions are not complete, but work enough for our purpose. +;; +;; (defun local-variable-p (variable &optional buffer) +;; "Non-nil if VARIABLE has a local binding in buffer BUFFER. +;; BUFFER defaults to the current buffer." +;; (and (or (assq variable (buffer-local-variables buffer)) ; local and bound. +;; (memq variable (buffer-local-variables buffer))); local but void. +;; ;; docstring is ambiguous; 20.3 returns bool value. +;; t)) +;; +;; (defun local-variable-if-set-p (variable &optional buffer) +;; "Non-nil if VARIABLE will be local in buffer BUFFER if it is set there. +;; BUFFER defaults to the current buffer." +;; (and (or (assq variable (buffer-local-variables buffer)) ; local and bound. +;; (memq variable (buffer-local-variables buffer))); local but void. +;; ;; docstring is ambiguous; 20.3 returns bool value. +;; t)) + +;;; @ Hook manipulation functions. +;;; + +;;; The following three functions are imported from emacs-20.3/lisp/subr.el. +;;; (local-variable-p, and local-variable-if-set-p are replaced.) +(defun make-local-hook (hook) + "Make the hook HOOK local to the current buffer. +The return value is HOOK. + +When a hook is local, its local and global values +work in concert: running the hook actually runs all the hook +functions listed in *either* the local value *or* the global value +of the hook variable. + +This function works by making `t' a member of the buffer-local value, +which acts as a flag to run the hook functions in the default value as +well. This works for all normal hooks, but does not work for most +non-normal hooks yet. We will be changing the callers of non-normal +hooks so that they can handle localness; this has to be done one by +one. + +This function does nothing if HOOK is already local in the current +buffer. + +Do not use `make-local-variable' to make a hook variable buffer-local." + (if ;; (local-variable-p hook) + (or (assq hook (buffer-local-variables)) ; local and bound. + (memq hook (buffer-local-variables))); local but void. + nil + (or (boundp hook) (set hook nil)) + (make-local-variable hook) + (set hook (list t))) + hook) + +(defun add-hook (hook function &optional append local) + "Add to the value of HOOK the function FUNCTION. +FUNCTION is not added if already present. +FUNCTION is added (if necessary) at the beginning of the hook list +unless the optional argument APPEND is non-nil, in which case +FUNCTION is added at the end. + +The optional fourth argument, LOCAL, if non-nil, says to modify +the hook's buffer-local value rather than its default value. +This makes no difference if the hook is not buffer-local. +To make a hook variable buffer-local, always use +`make-local-hook', not `make-local-variable'. + +HOOK should be a symbol, and FUNCTION may be any valid function. If +HOOK is void, it is first set to nil. If HOOK's value is a single +function, it is changed to a list of functions." + (or (boundp hook) (set hook nil)) + (or (default-boundp hook) (set-default hook nil)) + ;; If the hook value is a single function, turn it into a list. + (let ((old (symbol-value hook))) + (if (or (not (listp old)) (eq (car old) 'lambda)) + (set hook (list old)))) + (if (or local + ;; Detect the case where make-local-variable was used on a hook + ;; and do what we used to do. + (and ;; (local-variable-if-set-p hook) + (or (assq hook (buffer-local-variables)) ; local and bound. + (memq hook (buffer-local-variables))); local but void. + (not (memq t (symbol-value hook))))) + ;; Alter the local value only. + (or (if (or (consp function) (byte-code-function-p function)) + (member function (symbol-value hook)) + (memq function (symbol-value hook))) + (set hook + (if append + (append (symbol-value hook) (list function)) + (cons function (symbol-value hook))))) + ;; Alter the global value (which is also the only value, + ;; if the hook doesn't have a local value). + (or (if (or (consp function) (byte-code-function-p function)) + (member function (default-value hook)) + (memq function (default-value hook))) + (set-default hook + (if append + (append (default-value hook) (list function)) + (cons function (default-value hook))))))) + +(defun remove-hook (hook function &optional local) + "Remove from the value of HOOK the function FUNCTION. +HOOK should be a symbol, and FUNCTION may be any valid function. If +FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the +list of hooks to run in HOOK, then nothing is done. See `add-hook'. + +The optional third argument, LOCAL, if non-nil, says to modify +the hook's buffer-local value rather than its default value. +This makes no difference if the hook is not buffer-local. +To make a hook variable buffer-local, always use +`make-local-hook', not `make-local-variable'." + (if (or (not (boundp hook)) ;unbound symbol, or + (not (default-boundp hook)) + (null (symbol-value hook)) ;value is nil, or + (null function)) ;function is nil, then + nil ;Do nothing. + (if (or local + ;; Detect the case where make-local-variable was used on a hook + ;; and do what we used to do. + (and ;; (local-variable-p hook) + (or (assq hook (buffer-local-variables)) ; local and bound. + (memq hook (buffer-local-variables))); local but void. + (consp (symbol-value hook)) + (not (memq t (symbol-value hook))))) + (let ((hook-value (symbol-value hook))) + (if (consp hook-value) + (if (member function hook-value) + (setq hook-value (delete function (copy-sequence hook-value)))) + (if (equal hook-value function) + (setq hook-value nil))) + (set hook hook-value)) + (let ((hook-value (default-value hook))) + (if (and (consp hook-value) (not (functionp hook-value))) + (if (member function hook-value) + (setq hook-value (delete function (copy-sequence hook-value)))) + (if (equal hook-value function) + (setq hook-value nil))) + (set-default hook hook-value))))) + + +;;; @ Hook execution functions. +;;; + +(defun run-hook-with-args-internal (hook args cond) +;; "Run HOOK with the specified arguments ARGS. +;; HOOK should be a symbol, a hook variable. Its value should be a list of +;; functions. We call those functions, one by one, passing arguments ARGS +;; to each of them, until specified COND is satisfied. If COND is nil, we +;; call those functions until one of them returns a non-nil value, and then +;; we return that value. If COND is t, we call those functions until one +;; of them returns nil, and then we return nil. If COND is not nil and not +;; t, we call all the functions." + (if (not (boundp hook)) + ;; hook is void. + (not cond) + (let* ((functions (symbol-value hook)) + (ret (eq cond t)) + (all (and cond (not ret))) + function) + (if (functionp functions) + ;; hook is just a function. + (apply functions args) + ;; hook is nil or a list of functions. + (while (and functions + (or all ; to-completion + (if cond + ret ; until-failure + (null ret)))) ; until-success + (setq function (car functions) + functions(cdr functions)) + (if (eq function t) + ;; this hook has a local binding. + ;; we must run the global binding too. + (let ((globals (default-value hook)) + global) + (if (functionp globals) + (setq ret (apply globals args)) + (while (and globals + (or all + (if cond + ret + (null ret)))) + (setq global (car globals) + globals(cdr globals)) + (or (eq global t) ; t should not occur. + (setq ret (apply global args)))))) + (setq ret (apply function args)))) + ret)))) + +;;; The following four functions are direct translation of their +;;; C definitions of emacs-20.3/src/eval.c. +(defun run-hooks (&rest hooks) + "Run each hook in HOOKS. Major mode functions use this. +Each argument should be a symbol, a hook variable. +These symbols are processed in the order specified. +If a hook symbol has a non-nil value, that value may be a function +or a list of functions to be called to run the hook. +If the value is a function, it is called with no arguments. +If it is a list, the elements are called, in order, with no arguments. + +To make a hook variable buffer-local, use `make-local-hook', +not `make-local-variable'." + (while hooks + (run-hook-with-args-internal (car hooks) nil 'to-completion) + (setq hooks (cdr hooks)))) + +(defun run-hook-with-args (hook &rest args) + "Run HOOK with the specified arguments ARGS. +HOOK should be a symbol, a hook variable. If HOOK has a non-nil +value, that value may be a function or a list of functions to be +called to run the hook. If the value is a function, it is called with +the given arguments and its return value is returned. If it is a list +of functions, those functions are called, in order, +with the given arguments ARGS. +It is best not to depend on the value return by `run-hook-with-args', +as that may change. + +To make a hook variable buffer-local, use `make-local-hook', +not `make-local-variable'." + (run-hook-with-args-internal hook args 'to-completion)) + +(defun run-hook-with-args-until-success (hook &rest args) + "Run HOOK with the specified arguments ARGS. +HOOK should be a symbol, a hook variable. Its value should +be a list of functions. We call those functions, one by one, +passing arguments ARGS to each of them, until one of them +returns a non-nil value. Then we return that value. +If all the functions return nil, we return nil. + +To make a hook variable buffer-local, use `make-local-hook', +not `make-local-variable'." + (run-hook-with-args-internal hook args nil)) + +(defun run-hook-with-args-until-failure (hook &rest args) + "Run HOOK with the specified arguments ARGS. +HOOK should be a symbol, a hook variable. Its value should +be a list of functions. We call those functions, one by one, +passing arguments ARGS to each of them, until one of them +returns nil. Then we return nil. +If all the functions return non-nil, we return non-nil. + +To make a hook variable buffer-local, use `make-local-hook', +not `make-local-variable'." + (run-hook-with-args-internal hook args t)) + +;;; @ End. +;;; + +(provide 'localhook) + +;;; localhook.el ends here.