home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-highlight-2.0 / unique-hooks.el < prev    next >
Encoding:
Text File  |  1992-08-20  |  2.3 KB  |  62 lines
  1. ;;*****************************************************************************
  2. ;;
  3. ;; Filename:    unique-hooks.el
  4. ;;
  5. ;; Copyright (C) 1992  Rod Whitby
  6. ;;
  7. ;; This program is free software; you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation; either version 1, or (at your option)
  10. ;; any later version.
  11. ;;
  12. ;; This program is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. ;; GNU General Public License for more details.
  16. ;;
  17. ;; You should have received a copy of the GNU General Public License
  18. ;; along with this program; if not, write to the Free Software
  19. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  20. ;;
  21. ;; Modified by:        Rod Whitby, <rwhitby@research.canon.oz.au>
  22. ;; Author:        Daniel LaLiberte, <liberte@cs.uiuc.edu>
  23. ;;
  24. ;; Description:    Prepend and postpend hook functions to hook variables if they
  25. ;;        are not already there.
  26. ;;
  27. ;;*****************************************************************************
  28.  
  29. ;;; $Id: unique-hooks.el,v 1.2 1992/08/18 04:16:24 rwhitby Rel $ 
  30.  
  31. (defun prepend-unique-hook (hook-var hook-function)
  32.   "Prepend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
  33. HOOK-VAR's value may be a single function or a list of functions."
  34.   (if (boundp hook-var)
  35.       (let ((value (symbol-value hook-var)))
  36.     (if (and (listp value) (not (eq (car value) 'lambda)))
  37.         (and (not (memq hook-function value))
  38.          (set hook-var
  39.               (cons hook-function value)))
  40.       (and (not (eq hook-function value))
  41.            (set hook-var
  42.             (list hook-function value)))))
  43.     (set hook-var (list hook-function))
  44.     ))
  45.  
  46. (defun postpend-unique-hook (hook-var hook-function)
  47.   "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
  48. HOOK-VAR's value may be a single function or a list of functions."
  49.   (if (boundp hook-var)
  50.       (let ((value (symbol-value hook-var)))
  51.     (if (and (listp value) (not (eq (car value) 'lambda)))
  52.         (and (not (memq hook-function value))
  53.          (set hook-var
  54.               (append value (list hook-function ))))
  55.       (and (not (eq hook-function value))
  56.            (set hook-var
  57.             (append value (list hook-function))))))
  58.     (set hook-var (list hook-function))
  59.     ))
  60.  
  61. (provide 'unique-hooks)
  62.