Commit | Line | Data |
---|---|---|
2b86d62c | 1 | ;;; loadhist.el --- lisp functions for working with feature groups |
b578f267 EN |
2 | |
3 | ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
2b86d62c RS |
4 | |
5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
6 | ;; Version: 1.0 | |
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. | |
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)) | |
a5c31fa1 | 58 | (error "%s is not a currently loaded feature" (symbol-name feature)) |
2b86d62c RS |
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 | ||
a5c31fa1 | 83 | (defun file-set-intersect (p q) |
2b86d62c RS |
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) | |
e01ac82c RS |
93 | "Return the list of loaded libraries that depend on FILE. |
94 | This can include FILE itself." | |
2b86d62c RS |
95 | (let ((provides (file-provides file)) (dependents nil)) |
96 | (mapcar | |
97 | (function (lambda (x) | |
a5c31fa1 | 98 | (if (file-set-intersect provides (file-requires (car x))) |
2b86d62c RS |
99 | (setq dependents (cons (car x) dependents))))) |
100 | load-history) | |
101 | dependents | |
102 | )) | |
103 | ||
d4708676 RS |
104 | (defun read-feature (prompt) |
105 | "Read a feature name \(string\) from the minibuffer, | |
106 | prompting with PROMPT and completing from `features', and | |
107 | return the feature \(symbol\)." | |
108 | (intern (completing-read prompt | |
109 | (mapcar (function (lambda (feature) | |
110 | (list (symbol-name feature)))) | |
111 | features) | |
112 | nil t))) | |
113 | ||
2b86d62c RS |
114 | ;;;###autoload |
115 | (defun unload-feature (feature &optional force) | |
116 | "Unload the library that provided FEATURE, restoring all its autoloads. | |
117 | If the feature is required by any other loaded code, and optional FORCE | |
118 | is nil, raise an error." | |
d4708676 | 119 | (interactive (list (read-feature "Feature: "))) |
2b86d62c | 120 | (if (not (featurep feature)) |
a5c31fa1 | 121 | (error "%s is not a currently loaded feature" (symbol-name feature))) |
2b86d62c | 122 | (if (not force) |
e01ac82c RS |
123 | (let* ((file (feature-file feature)) |
124 | (dependents (delete file (copy-sequence (file-dependents file))))) | |
2b86d62c | 125 | (if dependents |
a5c31fa1 | 126 | (error "Loaded libraries %s depend on %s" |
2b86d62c RS |
127 | (prin1-to-string dependents) file) |
128 | ))) | |
129 | (let* ((flist (feature-symbols feature)) (file (car flist))) | |
130 | (mapcar | |
131 | (function (lambda (x) | |
132 | (cond ((stringp x) nil) | |
c344d4be KH |
133 | ((consp x) |
134 | ;; Remove any feature names that this file provided. | |
135 | (if (eq (car x) 'provide) | |
136 | (setq features (delq (cdr x) features)))) | |
2b86d62c RS |
137 | ((boundp x) (makunbound x)) |
138 | ((fboundp x) | |
139 | (fmakunbound x) | |
140 | (let ((aload (get x 'autoload))) | |
a5c31fa1 RS |
141 | (if aload (fset x (cons 'autoload aload)))))))) |
142 | (cdr flist)) | |
143 | ;; Delete the load-history element for this file. | |
144 | (let ((elt (assoc file load-history))) | |
145 | (setq load-history (delq elt load-history))))) | |
2b86d62c RS |
146 | |
147 | (provide 'loadhist) | |
148 | ||
149 | ;;; loadhist.el ends here |