Commit | Line | Data |
---|---|---|
2b86d62c | 1 | ;;; loadhist.el --- lisp functions for working with feature groups |
b578f267 | 2 | |
0d30b337 | 3 | ;; Copyright (C) 1995, 1998, 2000, 2002, 2003, 2004, |
aaef169d | 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
2b86d62c RS |
5 | |
6 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
53c1fa0f | 7 | ;; Maintainer: FSF |
2b86d62c RS |
8 | ;; Keywords: internal |
9 | ||
131a0c01 KH |
10 | ;; This file is part of GNU Emacs. |
11 | ||
12 | ;; GNU Emacs 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 2, or (at your option) | |
15 | ;; any later version. | |
16 | ||
17 | ;; GNU Emacs 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 | |
b578f267 | 23 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
086add15 LK |
24 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
25 | ;; Boston, MA 02110-1301, USA. | |
131a0c01 | 26 | |
2b86d62c RS |
27 | ;;; Commentary: |
28 | ||
29 | ;; These functions exploit the load-history system variable. | |
fde4581d RS |
30 | ;; Entry points include `unload-feature', `symbol-file', and |
31 | ;; `feature-file', documented in the Emacs Lisp manual. | |
2b86d62c RS |
32 | |
33 | ;;; Code: | |
34 | ||
2b86d62c | 35 | (defun feature-symbols (feature) |
7dc2cc98 RS |
36 | "Return the file and list of definitions associated with FEATURE. |
37 | The value is actually the element of `load-history' | |
38 | for the file that did (provide FEATURE)." | |
2b86d62c | 39 | (catch 'foundit |
53c1fa0f DL |
40 | (mapc (lambda (x) |
41 | (if (member (cons 'provide feature) (cdr x)) | |
42 | (throw 'foundit x))) | |
43 | load-history) | |
2b86d62c RS |
44 | nil)) |
45 | ||
46 | (defun feature-file (feature) | |
47 | "Return the file name from which a given FEATURE was loaded. | |
48 | Actually, return the load argument, if any; this is sometimes the name of a | |
53c1fa0f DL |
49 | Lisp file without an extension. If the feature came from an `eval-buffer' on |
50 | a buffer with no associated file, or an `eval-region', return nil." | |
2b86d62c | 51 | (if (not (featurep feature)) |
53c1fa0f | 52 | (error "%S is not a currently loaded feature" feature) |
2b86d62c RS |
53 | (car (feature-symbols feature)))) |
54 | ||
27af61fe | 55 | (defun file-loadhist-lookup (file) |
1c11da91 RS |
56 | "Return the `load-history' element for FILE. |
57 | FILE can be a file name, or a library name. | |
58 | A library name is equivalent to the file name that `load-library' would load." | |
27af61fe RS |
59 | ;; First look for FILE as given. |
60 | (let ((symbols (assoc file load-history))) | |
61 | ;; Try converting a library name to an absolute file name. | |
62 | (and (null symbols) | |
1c11da91 RS |
63 | (let ((absname |
64 | (locate-file file load-path load-suffixes))) | |
65 | (and absname (not (equal absname file)) | |
66 | (setq symbols (cdr (assoc absname load-history)))))) | |
27af61fe RS |
67 | symbols)) |
68 | ||
2b86d62c | 69 | (defun file-provides (file) |
1c11da91 RS |
70 | "Return the list of features provided by FILE as it was loaded. |
71 | FILE can be a file name, or a library name. | |
72 | A library name is equivalent to the file name that `load-library' would load." | |
27af61fe | 73 | (let ((symbols (file-loadhist-lookup file)) |
53c1fa0f DL |
74 | provides) |
75 | (mapc (lambda (x) | |
76 | (if (and (consp x) (eq (car x) 'provide)) | |
77 | (setq provides (cons (cdr x) provides)))) | |
78 | symbols) | |
79 | provides)) | |
2b86d62c RS |
80 | |
81 | (defun file-requires (file) | |
1c11da91 RS |
82 | "Return the list of features required by FILE as it was loaded. |
83 | FILE can be a file name, or a library name. | |
84 | A library name is equivalent to the file name that `load-library' would load." | |
27af61fe | 85 | (let ((symbols (file-loadhist-lookup file)) |
53c1fa0f DL |
86 | requires) |
87 | (mapc (lambda (x) | |
88 | (if (and (consp x) (eq (car x) 'require)) | |
89 | (setq requires (cons (cdr x) requires)))) | |
90 | symbols) | |
91 | requires)) | |
92 | ||
93 | (defsubst file-set-intersect (p q) | |
94 | "Return the set intersection of two lists." | |
2b86d62c | 95 | (let ((ret nil)) |
53c1fa0f DL |
96 | (dolist (x p ret) |
97 | (if (memq x q) (setq ret (cons x ret)))) | |
98 | ret)) | |
2b86d62c RS |
99 | |
100 | (defun file-dependents (file) | |
e01ac82c | 101 | "Return the list of loaded libraries that depend on FILE. |
1c11da91 RS |
102 | This can include FILE itself. |
103 | FILE can be a file name, or a library name. | |
104 | A library name is equivalent to the file name that `load-library' would load." | |
53c1fa0f DL |
105 | (let ((provides (file-provides file)) |
106 | (dependents nil)) | |
107 | (dolist (x load-history dependents) | |
108 | (if (file-set-intersect provides (file-requires (car x))) | |
109 | (setq dependents (cons (car x) dependents)))) | |
110 | dependents)) | |
2b86d62c | 111 | |
d4708676 | 112 | (defun read-feature (prompt) |
fde4581d RS |
113 | "Read a feature name \(string\) from the minibuffer. |
114 | Prompt with PROMPT and completing from `features', and | |
d4708676 RS |
115 | return the feature \(symbol\)." |
116 | (intern (completing-read prompt | |
53c1fa0f DL |
117 | (mapcar (lambda (feature) |
118 | (list (symbol-name feature))) | |
d4708676 RS |
119 | features) |
120 | nil t))) | |
121 | ||
28d02da1 RS |
122 | (defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks) |
123 | (defvar unload-feature-special-hooks | |
28d8dff1 | 124 | '(after-change-functions |
7dc2cc98 RS |
125 | after-insert-file-functions auto-fill-function |
126 | before-change-functions blink-paren-function | |
127 | buffer-access-fontify-functions command-line-functions | |
128 | comment-indent-function kill-buffer-query-functions | |
129 | kill-emacs-query-functions lisp-indent-function | |
130 | mouse-position-function | |
131 | redisplay-end-trigger-functions temp-buffer-show-function | |
132 | window-scroll-functions window-size-change-functions | |
133 | write-region-annotate-functions) | |
3eef341a | 134 | "A list of special hooks from Info node `(elisp)Standard Hooks'. |
fde4581d RS |
135 | |
136 | These are symbols with hook-type values whose names don't end in | |
137 | `-hook' or `-hooks', from which `unload-feature' tries to remove | |
138 | pertinent symbols.") | |
139 | ||
dffc4dfc EZ |
140 | (defvar unload-hook-features-list nil |
141 | "List of features of the package being unloaded. | |
142 | ||
143 | This is meant to be used by FEATURE-unload-hook hooks, see the | |
144 | documentation of `unload-feature' for details.") | |
145 | ||
2b86d62c RS |
146 | ;;;###autoload |
147 | (defun unload-feature (feature &optional force) | |
148 | "Unload the library that provided FEATURE, restoring all its autoloads. | |
4370a375 | 149 | If the feature is required by any other loaded code, and prefix arg FORCE |
8cb16ad1 EZ |
150 | is nil, raise an error. |
151 | ||
152 | This function tries to undo modifications made by the package to | |
153 | hooks. Packages may define a hook FEATURE-unload-hook that is called | |
154 | instead of the normal heuristics for doing this. Such a hook should | |
155 | undo all the relevant global state changes that may have been made by | |
156 | loading the package or executing functions in it. It has access to | |
157 | the package's feature list (before anything is unbound) in the | |
158 | variable `unload-hook-features-list' and could remove features from it | |
159 | in the event that the package has done something normally-ill-advised, | |
160 | such as redefining an Emacs function." | |
4370a375 | 161 | (interactive (list (read-feature "Feature: ") current-prefix-arg)) |
191652f8 LK |
162 | (unless (featurep feature) |
163 | (error "%s is not a currently loaded feature" (symbol-name feature))) | |
164 | (unless force | |
165 | (let* ((file (feature-file feature)) | |
166 | (dependents (delete file (copy-sequence (file-dependents file))))) | |
167 | (when dependents | |
168 | (error "Loaded libraries %s depend on %s" | |
169 | (prin1-to-string dependents) file)))) | |
8cb16ad1 | 170 | (let* ((unload-hook-features-list (feature-symbols feature)) |
191652f8 | 171 | (file (pop unload-hook-features-list)) |
fde4581d RS |
172 | (unload-hook (intern-soft (concat (symbol-name feature) |
173 | "-unload-hook")))) | |
174 | ;; Try to avoid losing badly when hooks installed in critical | |
175 | ;; places go away. (Some packages install things on | |
176 | ;; `kill-buffer-hook', `activate-menubar-hook' and the like.) | |
557be036 RS |
177 | ;; First off, provide a clean way for package FOO to arrange |
178 | ;; this by adding hooks on the variable `FOO-unload-hook'. | |
fde4581d RS |
179 | (if unload-hook |
180 | (run-hooks unload-hook) | |
181 | ;; Otherwise, do our best. Look through the obarray for symbols | |
182 | ;; which seem to be hook variables or special hook functions and | |
183 | ;; remove anything from them which matches the feature-symbols | |
184 | ;; about to get zapped. Obviously this won't get anonymous | |
185 | ;; functions which the package might just have installed, and | |
186 | ;; there might be other important state, but this tactic | |
187 | ;; normally works. | |
188 | (mapatoms | |
189 | (lambda (x) | |
191652f8 LK |
190 | (when (and (boundp x) |
191 | (or (and (consp (symbol-value x)) ; Random hooks. | |
192 | (string-match "-hooks?\\'" (symbol-name x))) | |
193 | (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc. | |
194 | (dolist (y unload-hook-features-list) | |
bd0f9535 LK |
195 | (when (and (eq (car-safe y) 'defun) |
196 | (not (get (cdr y) 'autoload))) | |
197 | (remove-hook x (cdr y))))))) | |
198 | ;; Remove any feature-symbols from auto-mode-alist as well. | |
199 | (dolist (y unload-hook-features-list) | |
200 | (when (and (eq (car-safe y) 'defun) | |
201 | (not (get (cdr y) 'autoload))) | |
202 | (setq auto-mode-alist | |
203 | (rassq-delete-all (cdr y) auto-mode-alist))))) | |
191652f8 LK |
204 | (when (fboundp 'elp-restore-function) ; remove ELP stuff first |
205 | (dolist (elt unload-hook-features-list) | |
206 | (when (symbolp elt) | |
207 | (elp-restore-function elt)))) | |
208 | (dolist (x unload-hook-features-list) | |
209 | (if (consp x) | |
bd0f9535 LK |
210 | (cond |
211 | ;; Remove any feature names that this file provided. | |
212 | ((eq (car x) 'provide) | |
213 | (setq features (delq (cdr x) features))) | |
214 | ((eq (car x) 'defun) | |
215 | (let ((fun (cdr x))) | |
216 | (when (fboundp fun) | |
217 | (when (fboundp 'ad-unadvise) | |
218 | (ad-unadvise fun)) | |
219 | (fmakunbound fun) | |
220 | (let ((aload (get fun 'autoload))) | |
221 | (when aload | |
222 | (fset fun (cons 'autoload aload)))))))) | |
191652f8 LK |
223 | ;; Kill local values as much as possible. |
224 | (dolist (buf (buffer-list)) | |
225 | (with-current-buffer buf | |
226 | (kill-local-variable x))) | |
227 | ;; Get rid of the default binding if we can. | |
228 | (unless (local-variable-if-set-p x) | |
229 | (makunbound x)))) | |
a5c31fa1 | 230 | ;; Delete the load-history element for this file. |
bd0f9535 | 231 | (setq load-history (delq (assoc file load-history) load-history)))) |
2b86d62c RS |
232 | |
233 | (provide 'loadhist) | |
234 | ||
ab5796a9 | 235 | ;;; arch-tag: 70bb846a-c413-4f01-bf88-78dba4ac0798 |
2b86d62c | 236 | ;;; loadhist.el ends here |