home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / epoch / tek-epoch-stuff / maclib-toolbox.el < prev    next >
Encoding:
Text File  |  1991-10-22  |  2.3 KB  |  67 lines
  1. ;*****************************************************************************
  2. ;
  3. ; Filename:    maclib-toolbox.el
  4. ;
  5. ; Author:        as attributed below.
  6. ; Posted by:        Ken Wood, <kwood@austek.oz.au>
  7. ; Organisation:        Austek Microsystems Pty Ltd, Australia.
  8. ;
  9. ; Description:    Miscellaneous useful programming tools.
  10. ;
  11. ;*****************************************************************************
  12.  
  13. ; $Id: maclib-toolbox.el,v 1.5 1991/10/23 02:16:57 kwood Exp $
  14.  
  15. (provide 'maclib-toolbox)
  16.  
  17.  
  18. ;********** Adding to hooks *********
  19.  
  20. ; Author: Daniel LaLiberte, <liberte@cs.uiuc.edu>
  21.  
  22. (defun prepend-unique-hook (hook-var hook-function)
  23.   "Prepend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
  24. hook-var's value may be a single function or a list of functions."
  25.   (if (boundp hook-var)
  26.       (let ((value (symbol-value hook-var)))
  27.     (if (and (listp value) (not (eq (car value) 'lambda)))
  28.         (and (not (memq hook-function value))
  29.          (set hook-var
  30.               (cons hook-function value)))
  31.       (and (not (eq hook-function value))
  32.            (set hook-var
  33.             (list hook-function value)))))
  34.     (set hook-var (list hook-function))
  35.     ))
  36.  
  37. (defun postpend-unique-hook (hook-var hook-function)
  38.   "Postpend HOOK-VAR with HOOK-FUNCTION, if it is not already an element.
  39. hook-var's value may be a single function or a list of functions."
  40.   (if (boundp hook-var)
  41.       (let ((value (symbol-value hook-var)))
  42.     (if (and (listp value) (not (eq (car value) 'lambda)))
  43.         (and (not (memq hook-function value))
  44.          (set hook-var
  45.               (append value (list hook-function ))))
  46.       (and (not (eq hook-function value))
  47.            (set hook-var
  48.             (append value (list hook-function))))))
  49.     (set hook-var (list hook-function))
  50.     ))
  51.  
  52.  
  53. ; Author: Lynn Slater, <lrs@indetech.com>
  54.  
  55. (defun true-mode-name ()
  56.   "Returns the name of the mode in such a form that the mode may be
  57.   re-established by calling the function named by appending '-name' to
  58.   this string.  This differs from the variable called mode-name in that
  59.   this is guaranteed to work while the values held by the variable may
  60.   have embedded spaces or other junk.
  61.  
  62.   THIS MODE NAME IS GUARANTEED OK TO USE IN THE MODE LINE."
  63.   (let ((major-mode-name (symbol-name major-mode)))
  64.     (substring major-mode-name 0
  65.            (or   (string-match "-mode" major-mode-name)
  66.              (length major-mode-name)))))
  67.