home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / energize / energize-advise.el < prev    next >
Encoding:
Text File  |  1993-02-17  |  3.4 KB  |  95 lines
  1. ;;; -*- Mode:Emacs-Lisp -*-
  2. ;;; Copyright ⌐ 1991-1993 by Lucid, Inc.  All Rights Reserved.
  3.  
  4. ;;; This is greatly complicated by the fact that both the old functions
  5. ;;; and the new functions are dumped.  The only method I've found that
  6. ;;; works and doesn't have obscure bootstrapping/feedback problems is
  7. ;;; to RELOAD the original definition of the function we are advising
  8. ;;; at compile time so that we can extract its original docstring, and
  9. ;;; emit a modified version of that to the .elc version of this file.
  10.  
  11. ;; To avoid the problem that if the docstrings in energize-mode.el change, 
  12. ;; this file wouldn't pick that up unless it is compiled after that one,
  13. ;; this file explicitly loads the .el versions of the energize libraries
  14. ;; at compile-time.  Too bad the byte compiler isn't reentrant or we could
  15. ;; just force those to be recompiled and reloaded when this is compiled.
  16. ;; As it is, we pollute the compile environment with uncompiled source...
  17.  
  18. (eval-when-compile    ; this only works at compile-time anyway...
  19.  
  20.  ;; load the .el versions to make sure we get the *current* docstrings.
  21. (load-library "energize-mode.el")
  22. (load-library "energize-shell.el")
  23.  
  24. (defmacro energize-advise-function (fun library)
  25.   (if library
  26.       (let ((old (symbol-function fun)))
  27.     (load-library library)  ; to get original defs/doc strings
  28.     (if (eq old (symbol-function fun))
  29.         (error "%s failed to redefine %s" library fun))))
  30.   (let* ((name (symbol-name fun))
  31.      (saved (intern (concat "energize-orig-" name)))
  32.      (new (intern (concat "energize-" name)))
  33.      (nfun (symbol-function new))
  34.      odoc ndoc doc
  35.      int arglist args)
  36.     (setq odoc (documentation fun))
  37.     (if (equal "" odoc) setq odoc nil)
  38.     (or odoc (error "%s has no doc" fun))
  39.     (setq ndoc (documentation new))
  40.     (if (equal "" ndoc) (setq ndoc nil))
  41.     (or ndoc (error "%s has no doc" new))
  42.     (setq doc (concat odoc "\n\n" ndoc))
  43.  
  44.     ;; don't lose on autoloads
  45.     (if (eq 'autoload (car-safe (symbol-function fun)))
  46.     (error "%s is an autoload" fun))
  47.  
  48.     (cond ((compiled-function-p (symbol-function fun))
  49.        (setq arglist (aref (symbol-function fun) 0)
  50.          int (if (> (length (symbol-function fun)) 5)
  51.              (list 'interactive (aref (symbol-function fun) 5)))))
  52.       (t
  53.        (setq arglist (nth 1 (symbol-function fun))
  54.          int (nth 2 (symbol-function fun)))
  55.        (or (eq 'interactive (car-safe int)) (setq int nil))
  56.        ))
  57.  
  58.     (setq args (delq '&optional (copy-sequence arglist)))
  59.     (if (memq '&rest args) (error "can't cope with &rest, dude"))
  60.  
  61.     (` (progn
  62.      (or (fboundp '(, saved))
  63.          (fset '(, saved) (symbol-function '(, fun))))
  64.  
  65.      (defun (, fun) (, arglist)
  66.        (, doc)
  67.        (,@ (if int (list int) nil))
  68.        ((, new) (,@ args)))
  69.      ))))
  70.  
  71. ) ;closes eval-when-compile
  72.  
  73.  
  74. ;;; Install the advice...
  75. ;;; Be really careful when you're changing this junk.  Talk to jwz first.
  76.  
  77. ;; these are defined in energize-mode.el
  78. (energize-advise-function set-visited-file-name "files")
  79. (energize-advise-function find-file-noselect    nil)
  80. (energize-advise-function write-file        nil)
  81. (energize-advise-function normal-mode        nil)
  82.  
  83. (energize-advise-function ask-user-about-lock    "userlock")
  84.  
  85. (energize-advise-function next-error        "compile")
  86. ;(energize-advise-function previous-error    nil)
  87.  
  88. (energize-advise-function gdb-break        "gdb")
  89. (energize-advise-function gdb-step        nil)
  90. (energize-advise-function gdb-stepi        nil)
  91.  
  92. ;; these are defined in energize-shell.el
  93. (energize-advise-function comint-mark        "comint")
  94. (energize-advise-function comint-send-input    nil)
  95.