| 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 |
| 8 | |
| 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 |
| 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. |
| 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 | (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 | |
| 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." |
| 119 | (interactive (list (read-feature "Feature: "))) |
| 120 | (if (not (featurep feature)) |
| 121 | (error "%s is not a currently loaded feature" (symbol-name feature))) |
| 122 | (if (not force) |
| 123 | (let* ((file (feature-file feature)) |
| 124 | (dependents (delete file (copy-sequence (file-dependents file))))) |
| 125 | (if dependents |
| 126 | (error "Loaded libraries %s depend on %s" |
| 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) |
| 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)))) |
| 137 | ((boundp x) (makunbound x)) |
| 138 | ((fboundp x) |
| 139 | (fmakunbound x) |
| 140 | (let ((aload (get x 'autoload))) |
| 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))))) |
| 146 | |
| 147 | (provide 'loadhist) |
| 148 | |
| 149 | ;;; loadhist.el ends here |