[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

add-feature-hook: new function proposal

From: Stephen Gildea
Subject: add-feature-hook: new function proposal
Date: Thu, 05 Oct 2000 10:44:27 EDT

Here's functionality I don't see in Emacs 20.7 and that I have found
to be useful: a way to add a hook that invokes a package only if that
package is available.

I call my new function add-feature-hook.  It works by creating a
temporary hook that probes for the feature the first time the hook is
called.  This way the probe is not done until the feature might be
needed, possibly never.

This temporary hook needs the gentemp Lisp function, which is
not in Emacs Lisp, so I provide an implementation of that, too.

Here's how you might use add-feature-hook, if you don't know whether
the local site has pgp.el installed:

(add-feature-hook 'pgp 'mh-folder-mode-hook 'pgp-mh-folder-mode-hook)

And here's an implementation:

;;; It is intentional that the temp hook removes itself first
;;; and adds the permanent hook last.  That way if the permanent
;;; hook gets an error, the error will happen only once.
;;;      It is okay that the temp hook runs remove-hook and add-hook
;;; becauses these functions each create copies of the hook list
;;; and don't affect the list being run this time through.
(defun add-feature-hook (feature hook function &optional append local)
  "If FEATURE is available, add to the value of HOOK the FUNCTION.
Like `add-hook', but only considers adding FUNCTION if FEATURE is available."
  ;; We don't want to do the check for the feature until we need it,
  ;; because we might never need it, so create a temporary function
  ;; to do the check when needed.
  (let ((checking-fn-name (add-feature-hook-gentemp)))
    (fset checking-fn-name
          `(lambda ()
             (remove-hook ',hook ',checking-fn-name ',local)
             (if (require ',feature nil 'noerror)
                   (funcall ',function)
                   (add-hook ',hook ',function ',append ',local)))))
    ;; duplication check
    (let ((hook-list (if local
                         (and (boundp hook) (symbol-value hook))
                       (and (default-boundp hook) (default-value hook))))
          (found nil))
      (while (consp hook-list)
        (and (symbolp (car hook-list))
             (fboundp (car hook-list))  ;skip T, the local hook flag
             (listp (symbol-function (car hook-list)))
             ;; check only part of the lambda-list because
             ;; the gensym'ed name in the function varies.
             (equal (nth 3 (symbol-function (car hook-list)))
                    (nth 3 (symbol-function checking-fn-name)))
             ;; found's non-nil value is the symbol for interest's sake
             (setq found (car hook-list) hook-list nil))
        (setq hook-list (cdr hook-list)))
      (or found
          (add-hook hook checking-fn-name append local)))))

(defvar add-feature-hook-gentemp-counter 0)

(defun add-feature-hook-gentemp ()
  "Generate a new interned symbol with a unique name."
  (let (name)
    (while (prog1
                (setq name (format "AFH%d" add-feature-hook-gentemp-counter)))
             (setq add-feature-hook-gentemp-counter
                   (1+ add-feature-hook-gentemp-counter))))
    (intern name)))

reply via email to

[Prev in Thread] Current Thread [Next in Thread]