Mercurial > hg > xemacs-beta
annotate lisp/loadhist.el @ 4535:69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
lisp/ChangeLog addition:
2008-12-22 Aidan Kehoe <kehoea@parhasard.net>
* loadhist.el (symbol-file):
Add support for differentiating between variables and functions to
#'symbol-file.
* help.el (describe-function-1):
(describe-variable):
Call #'symbol-function explicitly with a 'defun or 'defvar
argument, depending on whether we're looking for a variable or a
function.
* cus-face.el (custom-declare-face):
Record information about the face in the load history; code taken
from GNU, pre-GPLv3 revision 1.45.
src/ChangeLog addition:
2008-12-22 Aidan Kehoe <kehoea@parhasard.net>
* symbols.c (Fdefine_function):
* eval.c (define_function):
Record explicitly that we're defining a function in the load
history, in both these files.
author | Aidan Kehoe <kehoea@parhasard.net> |
---|---|
date | Mon, 22 Dec 2008 14:07:48 +0000 |
parents | 69e6352406f0 |
children | 061e030e3270 |
rev | line source |
---|---|
428 | 1 ;;; loadhist.el --- lisp functions for working with feature groups |
2 | |
3 ;; Copyright (C) 1995 Free Software Foundation, Inc. | |
4 | |
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> | |
6 ;; Version: 1.0 | |
7 ;; Keywords: internal, dumped | |
8 | |
9 ;; This file is part of XEmacs. | |
10 | |
11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
12 ;; 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 ;; XEmacs is distributed in the hope that it will be useful, but | |
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
19 ;; General Public License for more details. | |
20 | |
21 ;; You should have received a copy of the GNU General Public License | |
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
23 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
24 ;; 02111-1307, USA. | |
25 | |
26 ;;; Synched up with: FSF 20.2. | |
27 | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
28 ;; #### Sync this file! |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
29 |
428 | 30 ;;; Commentary: |
31 | |
32 ;; This file is dumped with XEmacs. | |
33 | |
34 ;; These functions exploit the load-history system variable. | |
35 ;; Entry points include `unload-feature', `symbol-file', and `feature-file'. | |
36 | |
37 ;;; Code: | |
38 | |
39 ;; load-history is a list of entries that look like this: | |
40 ;; ("outline" outline-regexp ... (require . wid-edit) ... (provide . outline) ...) | |
41 | |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
42 (defun symbol-file (sym &optional type) |
428 | 43 "Return the input source from which SYM was loaded. |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
44 This is a file name, or nil if the source was a buffer with no associated file. |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
45 |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
46 If TYPE is nil or omitted, any kind of definition is acceptable. |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
47 If TYPE is `defun', then function, subr, special form or macro definitions |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
48 are acceptable. |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
49 If TYPE is `defvar', then variable definitions are acceptable. |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
50 |
4535
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
51 `defface' specifies a face definition only, and for the moment, it won't |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
52 return faces created with `make-face' or `copy-face', just those created |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
53 with `defface' and `custom-declare-face'." |
428 | 54 (interactive "SFind source file for symbol: ") ; XEmacs |
3368 | 55 (block look-up-symbol-file |
4535
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
56 (let (built-in-file autoload-cons symbol-details) |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
57 (when (and |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
58 (eq 'autoload |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
59 (car-safe (setq autoload-cons |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
60 (and (fboundp sym) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
61 (symbol-function sym))))) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
62 (or (and (or (null type) (eq 'defvar type)) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
63 (eq (fifth autoload-cons) 'keymap)) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
64 (and (or (null type) (eq 'defvar type)) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
65 (memq (fifth autoload-cons) '(nil macro))))) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
66 (return-from look-up-symbol-file |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
67 (locate-library (second autoload-cons)))) |
4535
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
68 (cond ((eq 'defvar type) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
69 ;; Load history entries corresponding to variables are just |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
70 ;; symbols. |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
71 (dolist (entry load-history) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
72 (when (memq sym (cdr entry)) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
73 (return-from look-up-symbol-file (car entry))))) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
74 ((not (null type)) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
75 ;; Non-variables have the type stored as the car of the entry. |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
76 (dolist (entry load-history) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
77 (when (and (setq symbol-details (rassq sym (cdr entry))) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
78 (eq type (car symbol-details))) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
79 (return-from look-up-symbol-file (car entry))))) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
80 (t |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
81 ;; If TYPE hasn't been specified, we need to check both for |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
82 ;; variables and other symbols. |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
83 (dolist (entry load-history) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
84 (when (or (memq sym (cdr entry)) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
85 (rassq sym (cdr entry))) |
69a1eda3da06
Distinguish vars and functions in #'symbol-file, #'describe-{function,variable}
Aidan Kehoe <kehoea@parhasard.net>
parents:
4367
diff
changeset
|
86 (return-from look-up-symbol-file (car entry)))))) |
4367
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
87 (setq built-in-file (built-in-symbol-file sym type)) |
69e6352406f0
Handle macros, autoloads correctly in symbol-file. Add an incomplete TYPE arg.
Aidan Kehoe <kehoea@parhasard.net>
parents:
3511
diff
changeset
|
88 (if built-in-file (concat source-directory "/src/" built-in-file))))) |
428 | 89 |
90 (defun feature-symbols (feature) | |
91 "Return the file and list of symbols associated with a given FEATURE." | |
92 (let ((pair `(provide . ,feature))) | |
93 (dolist (entry load-history) | |
94 (when (member pair (cdr entry)) | |
95 (return entry))))) | |
96 | |
97 (defun feature-file (feature) | |
98 "Return the file name from which a given FEATURE was loaded. | |
99 Actually, return the load argument, if any; this is sometimes the name of a | |
100 Lisp file without an extension. If the feature came from an eval-buffer on | |
101 a buffer with no associated file, or an eval-region, return nil." | |
102 (unless (featurep feature) | |
103 (error "%s is not a currently loaded feature" (symbol-name feature))) | |
104 (car (feature-symbols feature))) | |
105 | |
106 (defun file-symbols (file) | |
107 "Return the file and list of symbols associated with FILE. | |
108 The file name in the returned list is the string used to load the file, | |
109 and may not be the same string as FILE, but it will be equivalent." | |
110 (or (assoc file load-history) | |
111 (assoc (file-name-sans-extension file) load-history) | |
112 (assoc (concat file ".el") load-history) | |
113 (assoc (concat file ".elc") load-history))) | |
114 | |
115 (defun file-provides (file) | |
116 "Return the list of features provided by FILE." | |
117 (let ((provides nil)) | |
118 (dolist (x (cdr (file-symbols file))) | |
119 (when (eq (car-safe x) 'provide) | |
120 (push (cdr x) provides))) | |
121 provides)) | |
122 | |
123 (defun file-requires (file) | |
124 "Return the list of features required by FILE." | |
125 (let ((requires nil)) | |
126 (dolist (x (cdr (file-symbols file))) | |
127 (when (eq (car-safe x) 'require) | |
128 (push (cdr x) requires))) | |
129 requires)) | |
130 | |
131 (defun file-dependents (file) | |
132 "Return the list of loaded libraries that depend on FILE. | |
133 This can include FILE itself." | |
134 (let ((provides (file-provides file)) | |
135 (dependents nil)) | |
136 (dolist (entry load-history) | |
137 (dolist (x (cdr entry)) | |
138 (when (and (eq (car-safe x) 'require) | |
139 (memq (cdr-safe x) provides)) | |
140 (push (car entry) dependents)))) | |
141 dependents)) | |
142 | |
143 ;; FSFmacs | |
144 ;(defun read-feature (prompt) | |
145 ; "Read a feature name \(string\) from the minibuffer, | |
146 ;prompting with PROMPT and completing from `features', and | |
147 ;return the feature \(symbol\)." | |
148 ; (intern (completing-read prompt | |
149 ; (mapcar #'(lambda (feature) | |
150 ; (list (symbol-name feature))) | |
151 ; features) | |
152 ; nil t))) | |
153 | |
154 ;; ;;;###autoload | |
155 (defun unload-feature (feature &optional force) | |
156 "Unload the library that provided FEATURE, restoring all its autoloads. | |
157 If the feature is required by any other loaded code, and optional FORCE | |
158 is nil, raise an error." | |
159 (interactive "SFeature: ") | |
160 (unless (featurep feature) | |
161 (error "%s is not a currently loaded feature" (symbol-name feature))) | |
162 (when (not force) | |
163 (let* ((file (feature-file feature)) | |
164 (dependents (delete file (copy-sequence (file-dependents file))))) | |
165 (when dependents | |
166 (error "Loaded libraries %s depend on %s" | |
167 (prin1-to-string dependents) file)))) | |
442 | 168 (let* ((flist (feature-symbols feature)) |
996 | 169 (file (car flist)) |
170 (unloading-module nil)) | |
442 | 171 (flet ((reset-aload (x) |
172 (let ((aload (get x 'autoload))) | |
173 (if aload (fset x (cons 'autoload aload)))))) | |
428 | 174 (mapcar |
175 #'(lambda (x) | |
176 (cond ((stringp x) nil) | |
177 ((consp x) | |
178 ;; Remove any feature names that this file provided. | |
179 (if (eq (car x) 'provide) | |
996 | 180 (setq features (delq (cdr x) features)) |
181 (if (eq (car x) 'module) | |
182 (setq unloading-module t)))) | |
442 | 183 ((and (boundp x) |
184 (fboundp x)) | |
185 (makunbound x) | |
186 (fmakunbound x) | |
187 (reset-aload x)) | |
188 ((boundp x) | |
189 (makunbound x)) | |
428 | 190 ((fboundp x) |
191 (fmakunbound x) | |
442 | 192 (reset-aload x)))) |
193 (cdr flist))) | |
428 | 194 ;; Delete the load-history element for this file. |
195 (let ((elt (assoc file load-history))) | |
996 | 196 (setq load-history (delq elt load-history))) |
197 ;; If it is a module, really unload it. | |
198 (if unloading-module | |
1111 | 199 (declare-fboundp (unload-module (symbol-name feature)))))) |
428 | 200 |
201 (provide 'loadhist) | |
202 | |
203 ;;; loadhist.el ends here |