Commit | Line | Data |
---|---|---|
2b86d62c | 1 | ;;; loadhist.el --- lisp functions for working with feature groups |
b578f267 | 2 | |
53c1fa0f | 3 | ;; Copyright (C) 1995, 1998, 2000 Free Software Foundation, Inc. |
2b86d62c RS |
4 | |
5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
53c1fa0f | 6 | ;; Maintainer: FSF |
2b86d62c RS |
7 | ;; Keywords: internal |
8 | ||
131a0c01 KH |
9 | ;; This file is part of GNU Emacs. |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
13 | ;; the Free Software Foundation; either version 2, or (at your option) | |
14 | ;; any later version. | |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b578f267 EN |
22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
23 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
24 | ;; Boston, MA 02111-1307, USA. | |
131a0c01 | 25 | |
2b86d62c RS |
26 | ;;; Commentary: |
27 | ||
28 | ;; These functions exploit the load-history system variable. | |
fde4581d RS |
29 | ;; Entry points include `unload-feature', `symbol-file', and |
30 | ;; `feature-file', documented in the Emacs Lisp manual. | |
2b86d62c RS |
31 | |
32 | ;;; Code: | |
33 | ||
2b86d62c | 34 | (defun feature-symbols (feature) |
7dc2cc98 RS |
35 | "Return the file and list of definitions associated with FEATURE. |
36 | The value is actually the element of `load-history' | |
37 | for the file that did (provide FEATURE)." | |
2b86d62c | 38 | (catch 'foundit |
53c1fa0f DL |
39 | (mapc (lambda (x) |
40 | (if (member (cons 'provide feature) (cdr x)) | |
41 | (throw 'foundit x))) | |
42 | load-history) | |
2b86d62c RS |
43 | nil)) |
44 | ||
45 | (defun feature-file (feature) | |
46 | "Return the file name from which a given FEATURE was loaded. | |
47 | Actually, return the load argument, if any; this is sometimes the name of a | |
53c1fa0f DL |
48 | Lisp file without an extension. If the feature came from an `eval-buffer' on |
49 | a buffer with no associated file, or an `eval-region', return nil." | |
2b86d62c | 50 | (if (not (featurep feature)) |
53c1fa0f | 51 | (error "%S is not a currently loaded feature" feature) |
2b86d62c RS |
52 | (car (feature-symbols feature)))) |
53 | ||
54 | (defun file-provides (file) | |
55 | "Return the list of features provided by FILE." | |
53c1fa0f DL |
56 | (let ((symbols (cdr (assoc file load-history))) |
57 | provides) | |
58 | (mapc (lambda (x) | |
59 | (if (and (consp x) (eq (car x) 'provide)) | |
60 | (setq provides (cons (cdr x) provides)))) | |
61 | symbols) | |
62 | provides)) | |
2b86d62c RS |
63 | |
64 | (defun file-requires (file) | |
65 | "Return the list of features required by FILE." | |
53c1fa0f DL |
66 | (let ((symbols (cdr (assoc file load-history))) |
67 | requires) | |
68 | (mapc (lambda (x) | |
69 | (if (and (consp x) (eq (car x) 'require)) | |
70 | (setq requires (cons (cdr x) requires)))) | |
71 | symbols) | |
72 | requires)) | |
73 | ||
74 | (defsubst file-set-intersect (p q) | |
75 | "Return the set intersection of two lists." | |
2b86d62c | 76 | (let ((ret nil)) |
53c1fa0f DL |
77 | (dolist (x p ret) |
78 | (if (memq x q) (setq ret (cons x ret)))) | |
79 | ret)) | |
2b86d62c RS |
80 | |
81 | (defun file-dependents (file) | |
e01ac82c RS |
82 | "Return the list of loaded libraries that depend on FILE. |
83 | This can include FILE itself." | |
53c1fa0f DL |
84 | (let ((provides (file-provides file)) |
85 | (dependents nil)) | |
86 | (dolist (x load-history dependents) | |
87 | (if (file-set-intersect provides (file-requires (car x))) | |
88 | (setq dependents (cons (car x) dependents)))) | |
89 | dependents)) | |
2b86d62c | 90 | |
d4708676 | 91 | (defun read-feature (prompt) |
fde4581d RS |
92 | "Read a feature name \(string\) from the minibuffer. |
93 | Prompt with PROMPT and completing from `features', and | |
d4708676 RS |
94 | return the feature \(symbol\)." |
95 | (intern (completing-read prompt | |
53c1fa0f DL |
96 | (mapcar (lambda (feature) |
97 | (list (symbol-name feature))) | |
d4708676 RS |
98 | features) |
99 | nil t))) | |
100 | ||
fde4581d | 101 | (defvar loadhist-hook-functions |
28d8dff1 | 102 | '(after-change-functions |
7dc2cc98 RS |
103 | after-insert-file-functions auto-fill-function |
104 | before-change-functions blink-paren-function | |
105 | buffer-access-fontify-functions command-line-functions | |
106 | comment-indent-function kill-buffer-query-functions | |
107 | kill-emacs-query-functions lisp-indent-function | |
108 | mouse-position-function | |
109 | redisplay-end-trigger-functions temp-buffer-show-function | |
110 | window-scroll-functions window-size-change-functions | |
111 | write-region-annotate-functions) | |
3eef341a | 112 | "A list of special hooks from Info node `(elisp)Standard Hooks'. |
fde4581d RS |
113 | |
114 | These are symbols with hook-type values whose names don't end in | |
115 | `-hook' or `-hooks', from which `unload-feature' tries to remove | |
116 | pertinent symbols.") | |
117 | ||
2b86d62c RS |
118 | ;;;###autoload |
119 | (defun unload-feature (feature &optional force) | |
120 | "Unload the library that provided FEATURE, restoring all its autoloads. | |
4370a375 | 121 | If the feature is required by any other loaded code, and prefix arg FORCE |
2b86d62c | 122 | is nil, raise an error." |
4370a375 | 123 | (interactive (list (read-feature "Feature: ") current-prefix-arg)) |
2b86d62c | 124 | (if (not (featurep feature)) |
a5c31fa1 | 125 | (error "%s is not a currently loaded feature" (symbol-name feature))) |
2b86d62c | 126 | (if (not force) |
e01ac82c RS |
127 | (let* ((file (feature-file feature)) |
128 | (dependents (delete file (copy-sequence (file-dependents file))))) | |
2b86d62c | 129 | (if dependents |
a5c31fa1 | 130 | (error "Loaded libraries %s depend on %s" |
fde4581d RS |
131 | (prin1-to-string dependents) file)))) |
132 | (let* ((flist (feature-symbols feature)) | |
133 | (file (car flist)) | |
134 | (unload-hook (intern-soft (concat (symbol-name feature) | |
135 | "-unload-hook")))) | |
136 | ;; Try to avoid losing badly when hooks installed in critical | |
137 | ;; places go away. (Some packages install things on | |
138 | ;; `kill-buffer-hook', `activate-menubar-hook' and the like.) | |
139 | ;; First off, provide a clean way for package `foo' to arrange | |
140 | ;; this by defining `foo-unload-hook'. | |
141 | (if unload-hook | |
142 | (run-hooks unload-hook) | |
143 | ;; Otherwise, do our best. Look through the obarray for symbols | |
144 | ;; which seem to be hook variables or special hook functions and | |
145 | ;; remove anything from them which matches the feature-symbols | |
146 | ;; about to get zapped. Obviously this won't get anonymous | |
147 | ;; functions which the package might just have installed, and | |
148 | ;; there might be other important state, but this tactic | |
149 | ;; normally works. | |
150 | (mapatoms | |
151 | (lambda (x) | |
152 | (if (or (and (boundp x) ; Random hooks. | |
153 | (consp (symbol-value x)) | |
154 | (string-match "-hooks?\\'" (symbol-name x))) | |
057ab294 | 155 | (and (boundp x) ; Known abnormal hooks etc. |
fde4581d | 156 | (memq x loadhist-hook-functions))) |
53c1fa0f DL |
157 | (dolist (y (cdr flist)) |
158 | (remove-hook x y)))))) | |
3eef341a DL |
159 | (if (fboundp 'elp-restore-function) ; remove ELP stuff first |
160 | (dolist (elt (cdr flist)) | |
161 | (if (symbolp elt) | |
162 | (elp-restore-function elt)))) | |
53c1fa0f DL |
163 | (mapc |
164 | (lambda (x) | |
fde4581d RS |
165 | (cond ((stringp x) nil) |
166 | ((consp x) | |
167 | ;; Remove any feature names that this file provided. | |
168 | (if (eq (car x) 'provide) | |
7dc2cc98 | 169 | (setq features (delq (cdr x) features))) |
3147ee6d RS |
170 | (when (eq (car x) 'defvar) |
171 | ;; Kill local values as much as possible. | |
172 | (dolist (buf (buffer-list)) | |
173 | (with-current-buffer buf | |
174 | (kill-local-variable (cdr x)))) | |
175 | ;; Get rid of the default binding if we can. | |
176 | (unless (local-variable-if-set-p (cdr x)) | |
177 | (makunbound (cdr x))))) | |
28d8dff1 | 178 | (t |
28d8dff1 | 179 | (when (fboundp x) |
2249360b DL |
180 | (if (fboundp 'ad-unadvise) |
181 | (ad-unadvise x)) | |
28d8dff1 DL |
182 | (fmakunbound x) |
183 | (let ((aload (get x 'autoload))) | |
184 | (if aload (fset x (cons 'autoload aload)))))))) | |
a5c31fa1 RS |
185 | (cdr flist)) |
186 | ;; Delete the load-history element for this file. | |
187 | (let ((elt (assoc file load-history))) | |
188 | (setq load-history (delq elt load-history))))) | |
2b86d62c RS |
189 | |
190 | (provide 'loadhist) | |
191 | ||
ab5796a9 | 192 | ;;; arch-tag: 70bb846a-c413-4f01-bf88-78dba4ac0798 |
2b86d62c | 193 | ;;; loadhist.el ends here |