X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/b578f267af27af50e3c091f8c9c9eee939b69978..7c7ff7f5d18ebe74842db645eb6ff4b63e778f0b:/lisp/loadhist.el

diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 22387b4448..47863f06d0 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -1,6 +1,6 @@
 ;;; loadhist.el --- lisp functions for working with feature groups
 
-;; Copyright (C) 1995 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1998 Free Software Foundation, Inc.
 
 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Version: 1.0
@@ -26,19 +26,11 @@
 ;;; Commentary:
 
 ;; These functions exploit the load-history system variable.
-;; Entry points include `unload-feature', `symbol-file', and `feature-file'.
+;; Entry points include `unload-feature', `symbol-file', and
+;; `feature-file', documented in the Emacs Lisp manual.
 
 ;;; Code:
 
-(defun symbol-file (sym)
-  "Return the input source from which SYM was loaded.
-This is a file name, or nil if the source was a buffer with no associated file."
-  (catch 'foundit
-    (mapcar
-     (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x)))))
-     load-history)
-    nil))
-
 (defun feature-symbols (feature)
   "Return the file and list of symbols associated with a given FEATURE."
    (catch 'foundit
@@ -101,12 +93,38 @@ This can include FILE itself."
     dependents
     ))
 
+(defun read-feature (prompt)
+  "Read a feature name \(string\) from the minibuffer.
+Prompt with PROMPT and completing from `features', and
+return the feature \(symbol\)."
+  (intern (completing-read prompt
+			   (mapcar (function (lambda (feature)
+					       (list (symbol-name feature))))
+				   features)
+			   nil t)))
+
+(defvar loadhist-hook-functions
+  '(after-change-function after-change-functions
+after-insert-file-functions auto-fill-function before-change-function
+before-change-functions blink-paren-function
+buffer-access-fontify-functions command-line-functions
+comment-indent-function kill-buffer-query-functions
+kill-emacs-query-functions lisp-indent-function
+redisplay-end-trigger-functions temp-buffer-show-function
+window-scroll-functions window-size-change-functions
+write-region-annotate-functions)
+  "A list of special hooks from the `Standard Hooks' node of the Lisp manual.
+
+These are symbols with hook-type values whose names don't end in
+`-hook' or `-hooks', from which `unload-feature' tries to remove
+pertinent symbols.")
+
 ;;;###autoload
 (defun unload-feature (feature &optional force)
   "Unload the library that provided FEATURE, restoring all its autoloads.
 If the feature is required by any other loaded code, and optional FORCE
 is nil, raise an error."
-  (interactive "SFeature: ")
+  (interactive (list (read-feature "Feature: ")))
   (if (not (featurep feature))
       (error "%s is not a currently loaded feature" (symbol-name feature)))
   (if (not force)
@@ -114,21 +132,46 @@ is nil, raise an error."
 	     (dependents (delete file (copy-sequence (file-dependents file)))))
 	(if dependents
 	    (error "Loaded libraries %s depend on %s"
-		   (prin1-to-string dependents) file)
-	    )))
-  (let* ((flist (feature-symbols feature)) (file (car flist)))
+		   (prin1-to-string dependents) file))))
+  (let* ((flist (feature-symbols feature))
+         (file (car flist))
+         (unload-hook (intern-soft (concat (symbol-name feature)
+                                           "-unload-hook"))))
+    ;; Try to avoid losing badly when hooks installed in critical
+    ;; places go away.  (Some packages install things on
+    ;; `kill-buffer-hook', `activate-menubar-hook' and the like.)
+    ;; First off, provide a clean way for package `foo' to arrange
+    ;; this by defining `foo-unload-hook'.
+    (if unload-hook
+        (run-hooks unload-hook)
+      ;; Otherwise, do our best.  Look through the obarray for symbols
+      ;; which seem to be hook variables or special hook functions and
+      ;; remove anything from them which matches the feature-symbols
+      ;; about to get zapped.  Obviously this won't get anonymous
+      ;; functions which the package might just have installed, and
+      ;; there might be other important state, but this tactic
+      ;; normally works.
+      (mapatoms
+       (lambda (x)
+         (if (or (and (boundp x)        ; Random hooks.
+                      (consp (symbol-value x))
+                      (string-match "-hooks?\\'" (symbol-name x)))
+                 (and (fboundp x)       ; Known abnormal hooks etc.
+                      (memq x loadhist-hook-functions)))
+             (mapcar (lambda (y) (remove-hook x y))
+                     (cdr flist))))))
     (mapcar
-     (function (lambda (x) 
-		 (cond ((stringp x) nil)
-		       ((consp x)
-			;; Remove any feature names that this file provided.
-			(if (eq (car x) 'provide)
-			    (setq features (delq (cdr x) features))))
-		       ((boundp x) (makunbound x))
-		       ((fboundp x)
-			(fmakunbound x)
-			(let ((aload (get x 'autoload)))
-			  (if aload (fset x (cons 'autoload aload))))))))
+     (lambda (x) 
+       (cond ((stringp x) nil)
+             ((consp x)
+              ;; Remove any feature names that this file provided.
+              (if (eq (car x) 'provide)
+                  (setq features (delq (cdr x) features))))
+             ((boundp x) (makunbound x))
+             ((fboundp x)
+              (fmakunbound x)
+              (let ((aload (get x 'autoload)))
+                (if aload (fset x (cons 'autoload aload)))))))
      (cdr flist))
     ;; Delete the load-history element for this file.
     (let ((elt (assoc file load-history)))