Mercurial > hg > xemacs-beta

comparison lisp/utils/loadhist.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; loadhist.el --- lisp functions for working with feature groups
2 ;;; Copyright (C) 1995 Free Software Foundation, Inc.
3
4 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
5 ;; Version: 1.0
6 ;; Keywords: internal
7
8 ;; This file is part of XEmacs.
9
10 ;; XEmacs is free software; you can redistribute it and/or modify it
11 ;; under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; XEmacs is distributed in the hope that it will be useful, but
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
18 ;; General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
22 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
23
24 ;;; Synched up with: FSF 19.30.
25
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))
58 (error "%s is not a currently loaded feature" (symbol-name feature))
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
83 (defun file-set-intersect (p q)
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)
93 "Return the list of loaded libraries that depend on FILE.
94 This can include FILE itself."
95 (let ((provides (file-provides file)) (dependents nil))
96 (mapcar
97 (function (lambda (x)
98 (if (file-set-intersect provides (file-requires (car x)))
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))
111 (error "%s is not a currently loaded feature" (symbol-name feature)))
112 (if (not force)
113 (let* ((file (feature-file feature))
114 (dependents (delete file (copy-sequence (file-dependents file)))))
115 (if dependents
116 (error "Loaded libraries %s depend on %s"
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)
123 ((consp x)
124 ;; Remove any feature names that this file provided.
125 (if (eq (car x) 'provide)
126 (setq features (delq (cdr x) features))))
127 ((boundp x) (makunbound x))
128 ((fboundp x)
129 (fmakunbound x)
130 (let ((aload (get x 'autoload)))
131 (if aload (fset x (cons 'autoload aload))))))))
132 (cdr flist))
133 ;; Delete the load-history element for this file.
134 (let ((elt (assoc file load-history)))
135 (setq load-history (delq elt load-history)))))
136
137 (provide 'loadhist)
138
139 ;;; loadhist.el ends here