Mercurial > hg > xemacs-beta

comparison lisp/loadhist.el @ 233:52952cbfc5b5 r20-5b15

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-5b15
author cvs
date Mon, 13 Aug 2007 10:14:14 +0200
parents
children 85a06df23a9a
comparison
equal deleted inserted replaced
232:aa6545ea0638 233:52952cbfc5b5
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
28 ;;; Commentary:
29
30 ;; This file is dumped with XEmacs.
31
32 ;; These functions exploit the load-history system variable.
33 ;; Entry points include `unload-feature', `symbol-file', and `feature-file'.
34
35 ;;; Code:
36
37 (defun symbol-file (sym)
38 "Return the input source from which SYM was loaded.
39 This is a file name, or nil if the source was a buffer with no associated file."
40 (interactive "S") ; XEmacs
41 (catch 'foundit
42 (mapcar
43 (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x)))))
44 load-history)
45 nil))
46
47 (defun feature-symbols (feature)
48 "Return the file and list of symbols associated with a given FEATURE."
49 (catch 'foundit
50 (mapcar
51 (function (lambda (x)
52 (if (member (cons 'provide feature) (cdr x))
53 (throw 'foundit x))))
54 load-history)
55 nil))
56
57 (defun feature-file (feature)
58 "Return the file name from which a given FEATURE was loaded.
59 Actually, return the load argument, if any; this is sometimes the name of a
60 Lisp file without an extension. If the feature came from an eval-buffer on
61 a buffer with no associated file, or an eval-region, return nil."
62 (if (not (featurep feature))
63 (error "%s is not a currently loaded feature" (symbol-name feature))
64 (car (feature-symbols feature))))
65
66 (defun file-provides (file)
67 "Return the list of features provided by FILE."
68 (let ((symbols (cdr (assoc file load-history))) (provides nil))
69 (mapcar
70 (function (lambda (x)
71 (if (and (consp x) (eq (car x) 'provide))
72 (setq provides (cons (cdr x) provides)))))
73 symbols)
74 provides
75 ))
76
77 (defun file-requires (file)
78 "Return the list of features required by FILE."
79 (let ((symbols (cdr (assoc file load-history))) (requires nil))
80 (mapcar
81 (function (lambda (x)
82 (if (and (consp x) (eq (car x) 'require))
83 (setq requires (cons (cdr x) requires)))))
84 symbols)
85 requires
86 ))
87
88 (defun file-set-intersect (p q)
89 ;; Return the set intersection of two lists
90 (let ((ret nil))
91 (mapcar
92 (function (lambda (x) (if (memq x q) (setq ret (cons x ret)))))
93 p)
94 ret
95 ))
96
97 (defun file-dependents (file)
98 "Return the list of loaded libraries that depend on FILE.
99 This can include FILE itself."
100 (let ((provides (file-provides file)) (dependents nil))
101 (mapcar
102 (function (lambda (x)
103 (if (file-set-intersect provides (file-requires (car x)))
104 (setq dependents (cons (car x) dependents)))))
105 load-history)
106 dependents
107 ))
108
109 ;; FSFmacs
110 ;(defun read-feature (prompt)
111 ; "Read a feature name \(string\) from the minibuffer,
112 ;prompting with PROMPT and completing from `features', and
113 ;return the feature \(symbol\)."
114 ; (intern (completing-read prompt
115 ; (mapcar (function (lambda (feature)
116 ; (list (symbol-name feature))))
117 ; features)
118 ; nil t)))
119
120 ;; ;;;###autoload
121 (defun unload-feature (feature &optional force)
122 "Unload the library that provided FEATURE, restoring all its autoloads.
123 If the feature is required by any other loaded code, and optional FORCE
124 is nil, raise an error."
125 (interactive "SFeature: ")
126 (if (not (featurep feature))
127 (error "%s is not a currently loaded feature" (symbol-name feature)))
128 (if (not force)
129 (let* ((file (feature-file feature))
130 (dependents (delete file (copy-sequence (file-dependents file)))))
131 (if dependents
132 (error "Loaded libraries %s depend on %s"
133 (prin1-to-string dependents) file)
134 )))
135 (let* ((flist (feature-symbols feature)) (file (car flist)))
136 (mapcar
137 (function (lambda (x)
138 (cond ((stringp x) nil)
139 ((consp x)
140 ;; Remove any feature names that this file provided.
141 (if (eq (car x) 'provide)
142 (setq features (delq (cdr x) features))))
143 ((boundp x) (makunbound x))
144 ((fboundp x)
145 (fmakunbound x)
146 (let ((aload (get x 'autoload)))
147 (if aload (fset x (cons 'autoload aload))))))))
148 (cdr flist))
149 ;; Delete the load-history element for this file.
150 (let ((elt (assoc file load-history)))
151 (setq load-history (delq elt load-history)))))
152
153 (provide 'loadhist)
154
155 ;;; loadhist.el ends here