Mercurial > emacs
annotate lisp/loadhist.el @ 23752:001e0e875d56
* fast-lock.el (fast-lock-save-cache-1):
(fast-lock-cache-data): Rewritten to use with-temp-message.
author | Simon Marshall <simon@gnu.org> |
---|---|
date | Mon, 23 Nov 1998 11:13:33 +0000 |
parents | 2069e879bec5 |
children | 49a68c55c3ac |
rev | line source |
---|---|
2543 | 1 ;;; loadhist.el --- lisp functions for working with feature groups |
14169 | 2 |
22459
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
3 ;; Copyright (C) 1995, 1998 Free Software Foundation, Inc. |
2543 | 4 |
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
6 ;; Version: 1.0 | |
7 ;; Keywords: internal | |
8 | |
11289 | 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 | |
14169 | 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. | |
11289 | 25 |
2543 | 26 ;;; Commentary: |
27 | |
28 ;; These functions exploit the load-history system variable. | |
22459
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
29 ;; Entry points include `unload-feature', `symbol-file', and |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
30 ;; `feature-file', documented in the Emacs Lisp manual. |
2543 | 31 |
32 ;;; Code: | |
33 | |
23285
76798d29cb2b
(load-history-loaded): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
22459
diff
changeset
|
34 (defvar load-history-loaded nil |
23574
c8ba21ef69c4
(symbol-file): Load fns-*.el from exec-directory
Andreas Schwab <schwab@suse.de>
parents:
23285
diff
changeset
|
35 "Non-nil means we have loaded the file `fns-VERSION.el' in `exec-directory'. |
23285
76798d29cb2b
(load-history-loaded): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
22459
diff
changeset
|
36 That file records the part of `load-history' for preloaded files, |
76798d29cb2b
(load-history-loaded): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
22459
diff
changeset
|
37 which is cleared out before dumping to make Emacs smaller.") |
76798d29cb2b
(load-history-loaded): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
22459
diff
changeset
|
38 |
2543 | 39 (defun symbol-file (sym) |
40 "Return the input source from which SYM was loaded. | |
41 This is a file name, or nil if the source was a buffer with no associated file." | |
23285
76798d29cb2b
(load-history-loaded): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
22459
diff
changeset
|
42 (unless load-history-loaded |
23664
bf72d6351f29
(symbol-file): Run fns-VERSION.el through
Eli Zaretskii <eliz@gnu.org>
parents:
23574
diff
changeset
|
43 (load (expand-file-name |
bf72d6351f29
(symbol-file): Run fns-VERSION.el through
Eli Zaretskii <eliz@gnu.org>
parents:
23574
diff
changeset
|
44 ;; fns-XX.YY.ZZ.el does not work on DOS filesystem. |
23704
2069e879bec5
(symbol-file): For ms-dos, use fns.el without the
Eli Zaretskii <eliz@gnu.org>
parents:
23664
diff
changeset
|
45 (if (eq system-type 'ms-dos) |
2069e879bec5
(symbol-file): For ms-dos, use fns.el without the
Eli Zaretskii <eliz@gnu.org>
parents:
23664
diff
changeset
|
46 "fns.el" |
2069e879bec5
(symbol-file): For ms-dos, use fns.el without the
Eli Zaretskii <eliz@gnu.org>
parents:
23664
diff
changeset
|
47 (format "fns-%s.el" emacs-version)) |
23664
bf72d6351f29
(symbol-file): Run fns-VERSION.el through
Eli Zaretskii <eliz@gnu.org>
parents:
23574
diff
changeset
|
48 exec-directory) |
bf72d6351f29
(symbol-file): Run fns-VERSION.el through
Eli Zaretskii <eliz@gnu.org>
parents:
23574
diff
changeset
|
49 ;; The file name fns-%s.el already has a .el extension. |
bf72d6351f29
(symbol-file): Run fns-VERSION.el through
Eli Zaretskii <eliz@gnu.org>
parents:
23574
diff
changeset
|
50 nil nil t) |
23285
76798d29cb2b
(load-history-loaded): New variable.
Karl Heuer <kwzh@gnu.org>
parents:
22459
diff
changeset
|
51 (setq load-history-loaded t)) |
2543 | 52 (catch 'foundit |
53 (mapcar | |
54 (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x))))) | |
55 load-history) | |
56 nil)) | |
57 | |
58 (defun feature-symbols (feature) | |
59 "Return the file and list of symbols associated with a given FEATURE." | |
60 (catch 'foundit | |
61 (mapcar | |
62 (function (lambda (x) | |
63 (if (member (cons 'provide feature) (cdr x)) | |
64 (throw 'foundit x)))) | |
65 load-history) | |
66 nil)) | |
67 | |
68 (defun feature-file (feature) | |
69 "Return the file name from which a given FEATURE was loaded. | |
70 Actually, return the load argument, if any; this is sometimes the name of a | |
71 Lisp file without an extension. If the feature came from an eval-buffer on | |
72 a buffer with no associated file, or an eval-region, return nil." | |
73 (if (not (featurep feature)) | |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
74 (error "%s is not a currently loaded feature" (symbol-name feature)) |
2543 | 75 (car (feature-symbols feature)))) |
76 | |
77 (defun file-provides (file) | |
78 "Return the list of features provided by FILE." | |
79 (let ((symbols (cdr (assoc file load-history))) (provides nil)) | |
80 (mapcar | |
81 (function (lambda (x) | |
82 (if (and (consp x) (eq (car x) 'provide)) | |
83 (setq provides (cons (cdr x) provides))))) | |
84 symbols) | |
85 provides | |
86 )) | |
87 | |
88 (defun file-requires (file) | |
89 "Return the list of features required by FILE." | |
90 (let ((symbols (cdr (assoc file load-history))) (requires nil)) | |
91 (mapcar | |
92 (function (lambda (x) | |
93 (if (and (consp x) (eq (car x) 'require)) | |
94 (setq requires (cons (cdr x) requires))))) | |
95 symbols) | |
96 requires | |
97 )) | |
98 | |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
99 (defun file-set-intersect (p q) |
2543 | 100 ;; Return the set intersection of two lists |
101 (let ((ret nil)) | |
102 (mapcar | |
103 (function (lambda (x) (if (memq x q) (setq ret (cons x ret))))) | |
104 p) | |
105 ret | |
106 )) | |
107 | |
108 (defun file-dependents (file) | |
10498
8fb25f247533
(unload-feature): Don't care if FILE is a dependency of itself.
Richard M. Stallman <rms@gnu.org>
parents:
8108
diff
changeset
|
109 "Return the list of loaded libraries that depend on FILE. |
8fb25f247533
(unload-feature): Don't care if FILE is a dependency of itself.
Richard M. Stallman <rms@gnu.org>
parents:
8108
diff
changeset
|
110 This can include FILE itself." |
2543 | 111 (let ((provides (file-provides file)) (dependents nil)) |
112 (mapcar | |
113 (function (lambda (x) | |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
114 (if (file-set-intersect provides (file-requires (car x))) |
2543 | 115 (setq dependents (cons (car x) dependents))))) |
116 load-history) | |
117 dependents | |
118 )) | |
119 | |
16173
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
120 (defun read-feature (prompt) |
22459
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
121 "Read a feature name \(string\) from the minibuffer. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
122 Prompt with PROMPT and completing from `features', and |
16173
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
123 return the feature \(symbol\)." |
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
124 (intern (completing-read prompt |
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
125 (mapcar (function (lambda (feature) |
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
126 (list (symbol-name feature)))) |
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
127 features) |
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
128 nil t))) |
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
129 |
22459
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
130 (defvar loadhist-hook-functions |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
131 '(after-change-function after-change-functions |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
132 after-insert-file-functions auto-fill-function before-change-function |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
133 before-change-functions blink-paren-function |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
134 buffer-access-fontify-functions command-line-functions |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
135 comment-indent-function kill-buffer-query-functions |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
136 kill-emacs-query-functions lisp-indent-function |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
137 redisplay-end-trigger-functions temp-buffer-show-function |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
138 window-scroll-functions window-size-change-functions |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
139 write-region-annotate-functions) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
140 "A list of special hooks from the `Standard Hooks' node of the Lisp manual. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
141 |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
142 These are symbols with hook-type values whose names don't end in |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
143 `-hook' or `-hooks', from which `unload-feature' tries to remove |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
144 pertinent symbols.") |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
145 |
2543 | 146 ;;;###autoload |
147 (defun unload-feature (feature &optional force) | |
148 "Unload the library that provided FEATURE, restoring all its autoloads. | |
149 If the feature is required by any other loaded code, and optional FORCE | |
150 is nil, raise an error." | |
16173
9ba176963a26
(read-feature): New function.
Richard M. Stallman <rms@gnu.org>
parents:
14169
diff
changeset
|
151 (interactive (list (read-feature "Feature: "))) |
2543 | 152 (if (not (featurep feature)) |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
153 (error "%s is not a currently loaded feature" (symbol-name feature))) |
2543 | 154 (if (not force) |
10498
8fb25f247533
(unload-feature): Don't care if FILE is a dependency of itself.
Richard M. Stallman <rms@gnu.org>
parents:
8108
diff
changeset
|
155 (let* ((file (feature-file feature)) |
8fb25f247533
(unload-feature): Don't care if FILE is a dependency of itself.
Richard M. Stallman <rms@gnu.org>
parents:
8108
diff
changeset
|
156 (dependents (delete file (copy-sequence (file-dependents file))))) |
2543 | 157 (if dependents |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
158 (error "Loaded libraries %s depend on %s" |
22459
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
159 (prin1-to-string dependents) file)))) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
160 (let* ((flist (feature-symbols feature)) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
161 (file (car flist)) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
162 (unload-hook (intern-soft (concat (symbol-name feature) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
163 "-unload-hook")))) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
164 ;; Try to avoid losing badly when hooks installed in critical |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
165 ;; places go away. (Some packages install things on |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
166 ;; `kill-buffer-hook', `activate-menubar-hook' and the like.) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
167 ;; First off, provide a clean way for package `foo' to arrange |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
168 ;; this by defining `foo-unload-hook'. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
169 (if unload-hook |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
170 (run-hooks unload-hook) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
171 ;; Otherwise, do our best. Look through the obarray for symbols |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
172 ;; which seem to be hook variables or special hook functions and |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
173 ;; remove anything from them which matches the feature-symbols |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
174 ;; about to get zapped. Obviously this won't get anonymous |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
175 ;; functions which the package might just have installed, and |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
176 ;; there might be other important state, but this tactic |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
177 ;; normally works. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
178 (mapatoms |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
179 (lambda (x) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
180 (if (or (and (boundp x) ; Random hooks. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
181 (consp (symbol-value x)) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
182 (string-match "-hooks?\\'" (symbol-name x))) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
183 (and (fboundp x) ; Known abnormal hooks etc. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
184 (memq x loadhist-hook-functions))) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
185 (mapcar (lambda (y) (remove-hook x y)) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
186 (cdr flist)))))) |
2543 | 187 (mapcar |
22459
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
188 (lambda (x) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
189 (cond ((stringp x) nil) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
190 ((consp x) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
191 ;; Remove any feature names that this file provided. |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
192 (if (eq (car x) 'provide) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
193 (setq features (delq (cdr x) features)))) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
194 ((boundp x) (makunbound x)) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
195 ((fboundp x) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
196 (fmakunbound x) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
197 (let ((aload (get x 'autoload))) |
bc88a299d2fc
(read-feature): Doc fix.
Richard M. Stallman <rms@gnu.org>
parents:
16173
diff
changeset
|
198 (if aload (fset x (cons 'autoload aload))))))) |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
199 (cdr flist)) |
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
200 ;; Delete the load-history element for this file. |
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
201 (let ((elt (assoc file load-history))) |
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
202 (setq load-history (delq elt load-history))))) |
2543 | 203 |
204 (provide 'loadhist) | |
205 | |
206 ;;; loadhist.el ends here |