Commit | Line | Data |
---|---|---|
2b86d62c | 1 | ;;; loadhist.el --- lisp functions for working with feature groups |
b578f267 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 1995, 1998, 2000-2013 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 | ||
eb3fa2cf | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
131a0c01 | 12 | ;; it under the terms of the GNU General Public License as published by |
eb3fa2cf GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
131a0c01 KH |
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 | |
eb3fa2cf | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
131a0c01 | 23 | |
2b86d62c RS |
24 | ;;; Commentary: |
25 | ||
26 | ;; These functions exploit the load-history system variable. | |
fde4581d RS |
27 | ;; Entry points include `unload-feature', `symbol-file', and |
28 | ;; `feature-file', documented in the Emacs Lisp manual. | |
2b86d62c RS |
29 | |
30 | ;;; Code: | |
31 | ||
2b86d62c | 32 | (defun feature-symbols (feature) |
7dc2cc98 RS |
33 | "Return the file and list of definitions associated with FEATURE. |
34 | The value is actually the element of `load-history' | |
35 | for the file that did (provide FEATURE)." | |
b5307e9c JB |
36 | (catch 'foundit |
37 | (let ((element (cons 'provide feature))) | |
38 | (dolist (x load-history nil) | |
39 | (when (member element (cdr x)) | |
40 | (throw 'foundit x)))))) | |
2b86d62c RS |
41 | |
42 | (defun feature-file (feature) | |
43 | "Return the file name from which a given FEATURE was loaded. | |
44 | Actually, return the load argument, if any; this is sometimes the name of a | |
53c1fa0f DL |
45 | Lisp file without an extension. If the feature came from an `eval-buffer' on |
46 | a buffer with no associated file, or an `eval-region', return nil." | |
2b86d62c | 47 | (if (not (featurep feature)) |
53c1fa0f | 48 | (error "%S is not a currently loaded feature" feature) |
2b86d62c RS |
49 | (car (feature-symbols feature)))) |
50 | ||
27af61fe | 51 | (defun file-loadhist-lookup (file) |
1c11da91 RS |
52 | "Return the `load-history' element for FILE. |
53 | FILE can be a file name, or a library name. | |
54 | A library name is equivalent to the file name that `load-library' would load." | |
27af61fe RS |
55 | ;; First look for FILE as given. |
56 | (let ((symbols (assoc file load-history))) | |
57 | ;; Try converting a library name to an absolute file name. | |
58 | (and (null symbols) | |
e18ce91d LT |
59 | (let ((absname |
60 | (locate-file file load-path (get-load-suffixes)))) | |
1c11da91 RS |
61 | (and absname (not (equal absname file)) |
62 | (setq symbols (cdr (assoc absname load-history)))))) | |
27af61fe RS |
63 | symbols)) |
64 | ||
2b86d62c | 65 | (defun file-provides (file) |
1c11da91 RS |
66 | "Return the list of features provided by FILE as it was loaded. |
67 | FILE can be a file name, or a library name. | |
68 | A library name is equivalent to the file name that `load-library' would load." | |
b5307e9c JB |
69 | (let (provides) |
70 | (dolist (x (file-loadhist-lookup file) provides) | |
71 | (when (eq (car-safe x) 'provide) | |
8f696e65 | 72 | (push (cdr x) provides))))) |
2b86d62c RS |
73 | |
74 | (defun file-requires (file) | |
1c11da91 RS |
75 | "Return the list of features required by FILE as it was loaded. |
76 | FILE can be a file name, or a library name. | |
77 | A library name is equivalent to the file name that `load-library' would load." | |
b5307e9c JB |
78 | (let (requires) |
79 | (dolist (x (file-loadhist-lookup file) requires) | |
80 | (when (eq (car-safe x) 'require) | |
8f696e65 | 81 | (push (cdr x) requires))))) |
53c1fa0f DL |
82 | |
83 | (defsubst file-set-intersect (p q) | |
84 | "Return the set intersection of two lists." | |
b5307e9c | 85 | (let (ret) |
53c1fa0f | 86 | (dolist (x p ret) |
b5307e9c | 87 | (when (memq x q) (push x ret))))) |
2b86d62c RS |
88 | |
89 | (defun file-dependents (file) | |
e01ac82c | 90 | "Return the list of loaded libraries that depend on FILE. |
1c11da91 RS |
91 | This can include FILE itself. |
92 | FILE can be a file name, or a library name. | |
93 | A library name is equivalent to the file name that `load-library' would load." | |
53c1fa0f DL |
94 | (let ((provides (file-provides file)) |
95 | (dependents nil)) | |
96 | (dolist (x load-history dependents) | |
b5307e9c JB |
97 | (when (file-set-intersect provides (file-requires (car x))) |
98 | (push (car x) dependents))))) | |
2b86d62c | 99 | |
12d9b59e KS |
100 | (defun read-feature (prompt &optional loaded-p) |
101 | "Read feature name from the minibuffer, prompting with string PROMPT. | |
102 | If optional second arg LOADED-P is non-nil, the feature must be loaded | |
103 | from a file." | |
104 | (intern | |
105 | (completing-read prompt | |
106 | (cons nil features) | |
107 | (and loaded-p | |
108 | #'(lambda (f) | |
109 | (and f ; ignore nil | |
110 | (feature-file f)))) | |
111 | loaded-p))) | |
d4708676 | 112 | |
28d02da1 RS |
113 | (defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks) |
114 | (defvar unload-feature-special-hooks | |
b5307e9c | 115 | '(after-change-functions after-insert-file-functions |
a1e65d42 JB |
116 | after-make-frame-functions auto-coding-functions |
117 | auto-fill-function before-change-functions | |
9910a311 | 118 | blink-paren-function buffer-access-fontify-functions |
a1e65d42 JB |
119 | choose-completion-string-functions |
120 | comint-output-filter-functions command-line-functions | |
121 | comment-indent-function compilation-finish-functions | |
2c587104 | 122 | delete-frame-functions disabled-command-function |
a1e65d42 JB |
123 | fill-nobreak-predicate find-directory-functions |
124 | find-file-not-found-functions | |
125 | font-lock-beginning-of-syntax-function | |
126 | font-lock-fontify-buffer-function | |
127 | font-lock-fontify-region-function | |
128 | font-lock-mark-block-function | |
129 | font-lock-syntactic-face-function | |
130 | font-lock-unfontify-buffer-function | |
131 | font-lock-unfontify-region-function | |
132 | kill-buffer-query-functions kill-emacs-query-functions | |
133 | lisp-indent-function mouse-position-function | |
40ba43b4 | 134 | redisplay-end-trigger-functions suspend-tty-functions |
a1e65d42 JB |
135 | temp-buffer-show-function window-scroll-functions |
136 | window-size-change-functions write-contents-functions | |
137 | write-file-functions write-region-annotate-functions) | |
3eef341a | 138 | "A list of special hooks from Info node `(elisp)Standard Hooks'. |
fde4581d | 139 | |
8ed7fe5c RS |
140 | These are symbols with hooklike values whose names don't end in |
141 | `-hook' or `-hooks', from which `unload-feature' should try to remove | |
fde4581d RS |
142 | pertinent symbols.") |
143 | ||
e5bd0a28 SM |
144 | (define-obsolete-variable-alias 'unload-hook-features-list |
145 | 'unload-function-defs-list "22.2") | |
8ed7fe5c | 146 | (defvar unload-function-defs-list nil |
4c36be58 | 147 | "List of definitions in the Lisp library being unloaded. |
dffc4dfc | 148 | |
8ed7fe5c | 149 | This is meant to be used by `FEATURE-unload-function'; see the |
dffc4dfc EZ |
150 | documentation of `unload-feature' for details.") |
151 | ||
519d22cc JB |
152 | (defun unload--set-major-mode () |
153 | (save-current-buffer | |
154 | (dolist (buffer (buffer-list)) | |
155 | (set-buffer buffer) | |
156 | (let ((proposed major-mode)) | |
a87ef899 | 157 | ;; Look for a predecessor mode not defined in the feature we're processing |
519d22cc JB |
158 | (while (and proposed (rassq proposed unload-function-defs-list)) |
159 | (setq proposed (get proposed 'derived-mode-parent))) | |
160 | (unless (eq proposed major-mode) | |
161 | ;; Two cases: either proposed is nil, and we want to switch to fundamental | |
162 | ;; mode, or proposed is not nil and not major-mode, and so we use it. | |
163 | (funcall (or proposed 'fundamental-mode))))))) | |
164 | ||
2b86d62c RS |
165 | ;;;###autoload |
166 | (defun unload-feature (feature &optional force) | |
8ed7fe5c | 167 | "Unload the library that provided FEATURE. |
4370a375 | 168 | If the feature is required by any other loaded code, and prefix arg FORCE |
8cb16ad1 EZ |
169 | is nil, raise an error. |
170 | ||
8ed7fe5c RS |
171 | Standard unloading activities include restoring old autoloads for |
172 | functions defined by the library, undoing any additions that the | |
173 | library has made to hook variables or to `auto-mode-alist', undoing | |
174 | ELP profiling of functions in that library, unproviding any features | |
175 | provided by the library, and canceling timers held in variables | |
176 | defined by the library. | |
177 | ||
178 | If a function `FEATURE-unload-function' is defined, this function | |
179 | calls it with no arguments, before doing anything else. That function | |
180 | can do whatever is appropriate to undo the loading of the library. If | |
181 | `FEATURE-unload-function' returns non-nil, that suppresses the | |
182 | standard unloading of the library. Otherwise the standard unloading | |
183 | proceeds. | |
184 | ||
185 | `FEATURE-unload-function' has access to the package's list of | |
186 | definitions in the variable `unload-function-defs-list' and could | |
187 | remove symbols from it in the event that the package has done | |
188 | something strange, such as redefining an Emacs function." | |
12d9b59e KS |
189 | (interactive |
190 | (list | |
5c34b94b KS |
191 | (read-feature "Unload feature: " t) |
192 | current-prefix-arg)) | |
191652f8 LK |
193 | (unless (featurep feature) |
194 | (error "%s is not a currently loaded feature" (symbol-name feature))) | |
195 | (unless force | |
196 | (let* ((file (feature-file feature)) | |
197 | (dependents (delete file (copy-sequence (file-dependents file))))) | |
198 | (when dependents | |
199 | (error "Loaded libraries %s depend on %s" | |
200 | (prin1-to-string dependents) file)))) | |
8ed7fe5c RS |
201 | (let* ((unload-function-defs-list (feature-symbols feature)) |
202 | (file (pop unload-function-defs-list)) | |
531309eb RS |
203 | ;; If non-nil, this is a symbol for which we should |
204 | ;; restore a previous autoload if possible. | |
205 | restore-autoload | |
d66d6ac0 JB |
206 | (name (symbol-name feature)) |
207 | (unload-hook (intern-soft (concat name "-unload-hook"))) | |
208 | (unload-func (intern-soft (concat name "-unload-function")))) | |
209 | ;; If FEATURE-unload-function is defined and returns non-nil, | |
210 | ;; don't try to do anything more; otherwise proceed normally. | |
d83fb256 | 211 | (unless (and (fboundp unload-func) |
d66d6ac0 JB |
212 | (funcall unload-func)) |
213 | ;; Try to avoid losing badly when hooks installed in critical | |
214 | ;; places go away. (Some packages install things on | |
215 | ;; `kill-buffer-hook', `activate-menubar-hook' and the like.) | |
216 | (if unload-hook | |
217 | ;; First off, provide a clean way for package FOO to arrange | |
218 | ;; this by adding hooks on the variable `FOO-unload-hook'. | |
219 | ;; This is obsolete; FEATURE-unload-function should be used now. | |
220 | (run-hooks unload-hook) | |
221 | ;; Otherwise, do our best. Look through the obarray for symbols | |
222 | ;; which seem to be hook variables or special hook functions and | |
223 | ;; remove anything from them which matches the feature-symbols | |
224 | ;; about to get zapped. Obviously this won't get anonymous | |
225 | ;; functions which the package might just have installed, and | |
226 | ;; there might be other important state, but this tactic | |
227 | ;; normally works. | |
228 | (mapatoms | |
229 | (lambda (x) | |
230 | (when (and (boundp x) | |
231 | (or (and (consp (symbol-value x)) ; Random hooks. | |
232 | (string-match "-hooks?\\'" (symbol-name x))) | |
233 | (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc. | |
8ed7fe5c | 234 | (dolist (y unload-function-defs-list) |
d66d6ac0 JB |
235 | (when (and (eq (car-safe y) 'defun) |
236 | (not (get (cdr y) 'autoload))) | |
237 | (remove-hook x (cdr y))))))) | |
238 | ;; Remove any feature-symbols from auto-mode-alist as well. | |
8ed7fe5c | 239 | (dolist (y unload-function-defs-list) |
d66d6ac0 JB |
240 | (when (and (eq (car-safe y) 'defun) |
241 | (not (get (cdr y) 'autoload))) | |
242 | (setq auto-mode-alist | |
243 | (rassq-delete-all (cdr y) auto-mode-alist))))) | |
519d22cc JB |
244 | |
245 | ;; Change major mode in all buffers using one defined in the feature being unloaded. | |
246 | (unload--set-major-mode) | |
247 | ||
d66d6ac0 | 248 | (when (fboundp 'elp-restore-function) ; remove ELP stuff first |
8ed7fe5c | 249 | (dolist (elt unload-function-defs-list) |
d66d6ac0 JB |
250 | (when (symbolp elt) |
251 | (elp-restore-function elt)))) | |
531309eb | 252 | |
8ed7fe5c | 253 | (dolist (x unload-function-defs-list) |
d66d6ac0 | 254 | (if (consp x) |
f58e0fd5 | 255 | (pcase (car x) |
d66d6ac0 | 256 | ;; Remove any feature names that this file provided. |
f58e0fd5 | 257 | (`provide |
d66d6ac0 | 258 | (setq features (delq (cdr x) features))) |
f58e0fd5 | 259 | ((or `defun `autoload) |
d66d6ac0 JB |
260 | (let ((fun (cdr x))) |
261 | (when (fboundp fun) | |
262 | (when (fboundp 'ad-unadvise) | |
263 | (ad-unadvise fun)) | |
264 | (let ((aload (get fun 'autoload))) | |
265 | (if (and aload (eq fun restore-autoload)) | |
266 | (fset fun (cons 'autoload aload)) | |
267 | (fmakunbound fun)))))) | |
268 | ;; (t . SYMBOL) comes before (defun . SYMBOL) | |
269 | ;; and says we should restore SYMBOL's autoload | |
270 | ;; when we undefine it. | |
f58e0fd5 SM |
271 | (`t (setq restore-autoload (cdr x))) |
272 | ((or `require `defface) nil) | |
273 | (_ (message "Unexpected element %s in load-history" x))) | |
d66d6ac0 JB |
274 | ;; Kill local values as much as possible. |
275 | (dolist (buf (buffer-list)) | |
276 | (with-current-buffer buf | |
277 | (if (and (boundp x) (timerp (symbol-value x))) | |
278 | (cancel-timer (symbol-value x))) | |
279 | (kill-local-variable x))) | |
280 | (if (and (boundp x) (timerp (symbol-value x))) | |
281 | (cancel-timer (symbol-value x))) | |
282 | ;; Get rid of the default binding if we can. | |
283 | (unless (local-variable-if-set-p x) | |
284 | (makunbound x)))) | |
285 | ;; Delete the load-history element for this file. | |
286 | (setq load-history (delq (assoc file load-history) load-history)))) | |
54c6a1c4 JB |
287 | ;; Don't return load-history, it is not useful. |
288 | nil) | |
2b86d62c RS |
289 | |
290 | (provide 'loadhist) | |
291 | ||
292 | ;;; loadhist.el ends here |