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