Mercurial > emacs
annotate lisp/loadhist.el @ 16073:9aa821b11ac1
(Fencode_time) [_NEXT_SOURCE]: Use ZONE, not ABSZONE.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Mon, 02 Sep 1996 17:28:10 +0000 |
parents | 83f275dcd93a |
children | 9ba176963a26 |
rev | line source |
---|---|
2543 | 1 ;;; loadhist.el --- lisp functions for working with feature groups |
14169 | 2 |
3 ;; Copyright (C) 1995 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. | |
29 ;; Entry points include `unload-feature', `symbol-file', and `feature-file'. | |
30 | |
31 ;;; Code: | |
32 | |
33 (defun symbol-file (sym) | |
34 "Return the input source from which SYM was loaded. | |
35 This is a file name, or nil if the source was a buffer with no associated file." | |
36 (catch 'foundit | |
37 (mapcar | |
38 (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x))))) | |
39 load-history) | |
40 nil)) | |
41 | |
42 (defun feature-symbols (feature) | |
43 "Return the file and list of symbols associated with a given FEATURE." | |
44 (catch 'foundit | |
45 (mapcar | |
46 (function (lambda (x) | |
47 (if (member (cons 'provide feature) (cdr x)) | |
48 (throw 'foundit x)))) | |
49 load-history) | |
50 nil)) | |
51 | |
52 (defun feature-file (feature) | |
53 "Return the file name from which a given FEATURE was loaded. | |
54 Actually, return the load argument, if any; this is sometimes the name of a | |
55 Lisp file without an extension. If the feature came from an eval-buffer on | |
56 a buffer with no associated file, or an eval-region, return nil." | |
57 (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
|
58 (error "%s is not a currently loaded feature" (symbol-name feature)) |
2543 | 59 (car (feature-symbols feature)))) |
60 | |
61 (defun file-provides (file) | |
62 "Return the list of features provided by FILE." | |
63 (let ((symbols (cdr (assoc file load-history))) (provides nil)) | |
64 (mapcar | |
65 (function (lambda (x) | |
66 (if (and (consp x) (eq (car x) 'provide)) | |
67 (setq provides (cons (cdr x) provides))))) | |
68 symbols) | |
69 provides | |
70 )) | |
71 | |
72 (defun file-requires (file) | |
73 "Return the list of features required by FILE." | |
74 (let ((symbols (cdr (assoc file load-history))) (requires nil)) | |
75 (mapcar | |
76 (function (lambda (x) | |
77 (if (and (consp x) (eq (car x) 'require)) | |
78 (setq requires (cons (cdr x) requires))))) | |
79 symbols) | |
80 requires | |
81 )) | |
82 | |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
83 (defun file-set-intersect (p q) |
2543 | 84 ;; Return the set intersection of two lists |
85 (let ((ret nil)) | |
86 (mapcar | |
87 (function (lambda (x) (if (memq x q) (setq ret (cons x ret))))) | |
88 p) | |
89 ret | |
90 )) | |
91 | |
92 (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
|
93 "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
|
94 This can include FILE itself." |
2543 | 95 (let ((provides (file-provides file)) (dependents nil)) |
96 (mapcar | |
97 (function (lambda (x) | |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
98 (if (file-set-intersect provides (file-requires (car x))) |
2543 | 99 (setq dependents (cons (car x) dependents))))) |
100 load-history) | |
101 dependents | |
102 )) | |
103 | |
104 ;;;###autoload | |
105 (defun unload-feature (feature &optional force) | |
106 "Unload the library that provided FEATURE, restoring all its autoloads. | |
107 If the feature is required by any other loaded code, and optional FORCE | |
108 is nil, raise an error." | |
109 (interactive "SFeature: ") | |
110 (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
|
111 (error "%s is not a currently loaded feature" (symbol-name feature))) |
2543 | 112 (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
|
113 (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
|
114 (dependents (delete file (copy-sequence (file-dependents file))))) |
2543 | 115 (if dependents |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
116 (error "Loaded libraries %s depend on %s" |
2543 | 117 (prin1-to-string dependents) file) |
118 ))) | |
119 (let* ((flist (feature-symbols feature)) (file (car flist))) | |
120 (mapcar | |
121 (function (lambda (x) | |
122 (cond ((stringp x) nil) | |
11844
cacb7820d1c7
(unload-feature): When we come to (provide . FEATURE),
Karl Heuer <kwzh@gnu.org>
parents:
11289
diff
changeset
|
123 ((consp x) |
cacb7820d1c7
(unload-feature): When we come to (provide . FEATURE),
Karl Heuer <kwzh@gnu.org>
parents:
11289
diff
changeset
|
124 ;; Remove any feature names that this file provided. |
cacb7820d1c7
(unload-feature): When we come to (provide . FEATURE),
Karl Heuer <kwzh@gnu.org>
parents:
11289
diff
changeset
|
125 (if (eq (car x) 'provide) |
cacb7820d1c7
(unload-feature): When we come to (provide . FEATURE),
Karl Heuer <kwzh@gnu.org>
parents:
11289
diff
changeset
|
126 (setq features (delq (cdr x) features)))) |
2543 | 127 ((boundp x) (makunbound x)) |
128 ((fboundp x) | |
129 (fmakunbound x) | |
130 (let ((aload (get x 'autoload))) | |
12751
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
131 (if aload (fset x (cons 'autoload aload)))))))) |
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
132 (cdr flist)) |
f442c14a79c4
(unload-feature): Delete the file's load-history element.
Richard M. Stallman <rms@gnu.org>
parents:
11844
diff
changeset
|
133 ;; 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
|
134 (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
|
135 (setq load-history (delq elt load-history))))) |
2543 | 136 |
137 (provide 'loadhist) | |
138 | |
139 ;;; loadhist.el ends here |