| 1 | ;;; loadhist.el --- lisp functions for working with feature groups |
| 2 | |
| 3 | ;; Copyright (C) 1995, 1998, 2000-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> |
| 6 | ;; Maintainer: emacs-devel@gnu.org |
| 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 3 of the License, or |
| 14 | ;; (at your option) 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. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; These functions exploit the load-history system variable. |
| 27 | ;; Entry points include `unload-feature', `symbol-file', and |
| 28 | ;; `feature-file', documented in the Emacs Lisp manual. |
| 29 | |
| 30 | ;;; Code: |
| 31 | |
| 32 | (defun feature-symbols (feature) |
| 33 | "Return the file and list of definitions associated with FEATURE. |
| 34 | The value is actually the element of `load-history' |
| 35 | for the file that did (provide FEATURE)." |
| 36 | (catch 'foundit |
| 37 | (let ((element (cons 'provide feature))) |
| 38 | (dolist (x load-history nil) |
| 39 | (when (member element (cdr x)) |
| 40 | (throw 'foundit x)))))) |
| 41 | |
| 42 | (defun feature-file (feature) |
| 43 | "Return the file name from which a given FEATURE was loaded. |
| 44 | Actually, return the load argument, if any; this is sometimes the name of a |
| 45 | Lisp file without an extension. If the feature came from an `eval-buffer' on |
| 46 | a buffer with no associated file, or an `eval-region', return nil." |
| 47 | (if (not (featurep feature)) |
| 48 | (error "%S is not a currently loaded feature" feature) |
| 49 | (car (feature-symbols feature)))) |
| 50 | |
| 51 | (defun file-loadhist-lookup (file) |
| 52 | "Return the `load-history' element for FILE. |
| 53 | FILE can be a file name, or a library name. |
| 54 | A library name is equivalent to the file name that `load-library' would load." |
| 55 | ;; First look for FILE as given. |
| 56 | (let ((symbols (assoc file load-history))) |
| 57 | ;; Try converting a library name to an absolute file name. |
| 58 | (and (null symbols) |
| 59 | (let ((absname |
| 60 | (locate-file file load-path (get-load-suffixes)))) |
| 61 | (and absname (not (equal absname file)) |
| 62 | (setq symbols (cdr (assoc absname load-history)))))) |
| 63 | symbols)) |
| 64 | |
| 65 | (defun file-provides (file) |
| 66 | "Return the list of features provided by FILE as it was loaded. |
| 67 | FILE can be a file name, or a library name. |
| 68 | A library name is equivalent to the file name that `load-library' would load." |
| 69 | (let (provides) |
| 70 | (dolist (x (file-loadhist-lookup file) provides) |
| 71 | (when (eq (car-safe x) 'provide) |
| 72 | (push (cdr x) provides))))) |
| 73 | |
| 74 | (defun file-requires (file) |
| 75 | "Return the list of features required by FILE as it was loaded. |
| 76 | FILE can be a file name, or a library name. |
| 77 | A library name is equivalent to the file name that `load-library' would load." |
| 78 | (let (requires) |
| 79 | (dolist (x (file-loadhist-lookup file) requires) |
| 80 | (when (eq (car-safe x) 'require) |
| 81 | (push (cdr x) requires))))) |
| 82 | |
| 83 | (defsubst file-set-intersect (p q) |
| 84 | "Return the set intersection of two lists." |
| 85 | (let (ret) |
| 86 | (dolist (x p ret) |
| 87 | (when (memq x q) (push x ret))))) |
| 88 | |
| 89 | (defun file-dependents (file) |
| 90 | "Return the list of loaded libraries that depend on FILE. |
| 91 | This can include FILE itself. |
| 92 | FILE can be a file name, or a library name. |
| 93 | A library name is equivalent to the file name that `load-library' would load." |
| 94 | (let ((provides (file-provides file)) |
| 95 | (dependents nil)) |
| 96 | (dolist (x load-history dependents) |
| 97 | (when (file-set-intersect provides (file-requires (car x))) |
| 98 | (push (car x) dependents))))) |
| 99 | |
| 100 | (defun read-feature (prompt &optional loaded-p) |
| 101 | "Read feature name from the minibuffer, prompting with string PROMPT. |
| 102 | If optional second arg LOADED-P is non-nil, the feature must be loaded |
| 103 | from a file." |
| 104 | (intern (completing-read prompt |
| 105 | features |
| 106 | (and loaded-p #'feature-file) |
| 107 | loaded-p))) |
| 108 | |
| 109 | (defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks) |
| 110 | (defvar unload-feature-special-hooks |
| 111 | '(after-change-functions after-insert-file-functions |
| 112 | after-make-frame-functions auto-coding-functions |
| 113 | auto-fill-function before-change-functions |
| 114 | blink-paren-function buffer-access-fontify-functions |
| 115 | choose-completion-string-functions |
| 116 | comint-output-filter-functions command-line-functions |
| 117 | comment-indent-function compilation-finish-functions |
| 118 | delete-frame-functions disabled-command-function |
| 119 | fill-nobreak-predicate find-directory-functions |
| 120 | find-file-not-found-functions |
| 121 | font-lock-beginning-of-syntax-function |
| 122 | font-lock-fontify-buffer-function |
| 123 | font-lock-fontify-region-function |
| 124 | font-lock-mark-block-function |
| 125 | font-lock-syntactic-face-function |
| 126 | font-lock-unfontify-buffer-function |
| 127 | font-lock-unfontify-region-function |
| 128 | kill-buffer-query-functions kill-emacs-query-functions |
| 129 | lisp-indent-function mouse-position-function |
| 130 | redisplay-end-trigger-functions suspend-tty-functions |
| 131 | temp-buffer-show-function window-scroll-functions |
| 132 | window-size-change-functions write-contents-functions |
| 133 | write-file-functions write-region-annotate-functions) |
| 134 | "A list of special hooks from Info node `(elisp)Standard Hooks'. |
| 135 | |
| 136 | These are symbols with hooklike values whose names don't end in |
| 137 | `-hook' or `-hooks', from which `unload-feature' should try to remove |
| 138 | pertinent symbols.") |
| 139 | |
| 140 | (define-obsolete-variable-alias 'unload-hook-features-list |
| 141 | 'unload-function-defs-list "22.2") |
| 142 | (defvar unload-function-defs-list nil |
| 143 | "List of definitions in the Lisp library being unloaded. |
| 144 | |
| 145 | This is meant to be used by `FEATURE-unload-function'; see the |
| 146 | documentation of `unload-feature' for details.") |
| 147 | |
| 148 | (defun unload--set-major-mode () |
| 149 | (save-current-buffer |
| 150 | (dolist (buffer (buffer-list)) |
| 151 | (set-buffer buffer) |
| 152 | (let ((proposed major-mode)) |
| 153 | ;; Look for a predecessor mode not defined in the feature we're processing |
| 154 | (while (and proposed (rassq proposed unload-function-defs-list)) |
| 155 | (setq proposed (get proposed 'derived-mode-parent))) |
| 156 | (unless (eq proposed major-mode) |
| 157 | ;; Two cases: either proposed is nil, and we want to switch to fundamental |
| 158 | ;; mode, or proposed is not nil and not major-mode, and so we use it. |
| 159 | (funcall (or proposed 'fundamental-mode))))))) |
| 160 | |
| 161 | ;;;###autoload |
| 162 | (defun unload-feature (feature &optional force) |
| 163 | "Unload the library that provided FEATURE. |
| 164 | If the feature is required by any other loaded code, and prefix arg FORCE |
| 165 | is nil, raise an error. |
| 166 | |
| 167 | Standard unloading activities include restoring old autoloads for |
| 168 | functions defined by the library, undoing any additions that the |
| 169 | library has made to hook variables or to `auto-mode-alist', undoing |
| 170 | ELP profiling of functions in that library, unproviding any features |
| 171 | provided by the library, and canceling timers held in variables |
| 172 | defined by the library. |
| 173 | |
| 174 | If a function `FEATURE-unload-function' is defined, this function |
| 175 | calls it with no arguments, before doing anything else. That function |
| 176 | can do whatever is appropriate to undo the loading of the library. If |
| 177 | `FEATURE-unload-function' returns non-nil, that suppresses the |
| 178 | standard unloading of the library. Otherwise the standard unloading |
| 179 | proceeds. |
| 180 | |
| 181 | `FEATURE-unload-function' has access to the package's list of |
| 182 | definitions in the variable `unload-function-defs-list' and could |
| 183 | remove symbols from it in the event that the package has done |
| 184 | something strange, such as redefining an Emacs function." |
| 185 | (interactive |
| 186 | (list |
| 187 | (read-feature "Unload feature: " t) |
| 188 | current-prefix-arg)) |
| 189 | (unless (featurep feature) |
| 190 | (error "%s is not a currently loaded feature" (symbol-name feature))) |
| 191 | (unless force |
| 192 | (let* ((file (feature-file feature)) |
| 193 | (dependents (delete file (copy-sequence (file-dependents file))))) |
| 194 | (when dependents |
| 195 | (error "Loaded libraries %s depend on %s" |
| 196 | (prin1-to-string dependents) file)))) |
| 197 | (let* ((unload-function-defs-list (feature-symbols feature)) |
| 198 | (file (pop unload-function-defs-list)) |
| 199 | ;; If non-nil, this is a symbol for which we should |
| 200 | ;; restore a previous autoload if possible. |
| 201 | restore-autoload |
| 202 | (name (symbol-name feature)) |
| 203 | (unload-hook (intern-soft (concat name "-unload-hook"))) |
| 204 | (unload-func (intern-soft (concat name "-unload-function")))) |
| 205 | ;; If FEATURE-unload-function is defined and returns non-nil, |
| 206 | ;; don't try to do anything more; otherwise proceed normally. |
| 207 | (unless (and (fboundp unload-func) |
| 208 | (funcall unload-func)) |
| 209 | ;; Try to avoid losing badly when hooks installed in critical |
| 210 | ;; places go away. (Some packages install things on |
| 211 | ;; `kill-buffer-hook', `activate-menubar-hook' and the like.) |
| 212 | (if unload-hook |
| 213 | ;; First off, provide a clean way for package FOO to arrange |
| 214 | ;; this by adding hooks on the variable `FOO-unload-hook'. |
| 215 | ;; This is obsolete; FEATURE-unload-function should be used now. |
| 216 | (run-hooks unload-hook) |
| 217 | ;; Otherwise, do our best. Look through the obarray for symbols |
| 218 | ;; which seem to be hook variables or special hook functions and |
| 219 | ;; remove anything from them which matches the feature-symbols |
| 220 | ;; about to get zapped. Obviously this won't get anonymous |
| 221 | ;; functions which the package might just have installed, and |
| 222 | ;; there might be other important state, but this tactic |
| 223 | ;; normally works. |
| 224 | (mapatoms |
| 225 | (lambda (x) |
| 226 | (when (and (boundp x) |
| 227 | (or (and (consp (symbol-value x)) ; Random hooks. |
| 228 | (string-match "-hooks?\\'" (symbol-name x))) |
| 229 | (memq x unload-feature-special-hooks))) ; Known abnormal hooks etc. |
| 230 | (dolist (y unload-function-defs-list) |
| 231 | (when (and (eq (car-safe y) 'defun) |
| 232 | (not (get (cdr y) 'autoload))) |
| 233 | (remove-hook x (cdr y))))))) |
| 234 | ;; Remove any feature-symbols from auto-mode-alist as well. |
| 235 | (dolist (y unload-function-defs-list) |
| 236 | (when (and (eq (car-safe y) 'defun) |
| 237 | (not (get (cdr y) 'autoload))) |
| 238 | (setq auto-mode-alist |
| 239 | (rassq-delete-all (cdr y) auto-mode-alist))))) |
| 240 | |
| 241 | ;; Change major mode in all buffers using one defined in the feature being unloaded. |
| 242 | (unload--set-major-mode) |
| 243 | |
| 244 | (when (fboundp 'elp-restore-function) ; remove ELP stuff first |
| 245 | (dolist (elt unload-function-defs-list) |
| 246 | (when (symbolp elt) |
| 247 | (elp-restore-function elt)))) |
| 248 | |
| 249 | (dolist (x unload-function-defs-list) |
| 250 | (if (consp x) |
| 251 | (pcase (car x) |
| 252 | ;; Remove any feature names that this file provided. |
| 253 | (`provide |
| 254 | (setq features (delq (cdr x) features))) |
| 255 | ((or `defun `autoload) |
| 256 | (let ((fun (cdr x))) |
| 257 | (when (fboundp fun) |
| 258 | (when (fboundp 'ad-unadvise) |
| 259 | (ad-unadvise fun)) |
| 260 | (let ((aload (get fun 'autoload))) |
| 261 | (if (and aload (eq fun restore-autoload)) |
| 262 | (fset fun (cons 'autoload aload)) |
| 263 | (fmakunbound fun)))))) |
| 264 | ;; (t . SYMBOL) comes before (defun . SYMBOL) |
| 265 | ;; and says we should restore SYMBOL's autoload |
| 266 | ;; when we undefine it. |
| 267 | (`t (setq restore-autoload (cdr x))) |
| 268 | ((or `require `defface) nil) |
| 269 | (_ (message "Unexpected element %s in load-history" x))) |
| 270 | ;; Kill local values as much as possible. |
| 271 | (dolist (buf (buffer-list)) |
| 272 | (with-current-buffer buf |
| 273 | (if (and (boundp x) (timerp (symbol-value x))) |
| 274 | (cancel-timer (symbol-value x))) |
| 275 | (kill-local-variable x))) |
| 276 | (if (and (boundp x) (timerp (symbol-value x))) |
| 277 | (cancel-timer (symbol-value x))) |
| 278 | ;; Get rid of the default binding if we can. |
| 279 | (unless (local-variable-if-set-p x) |
| 280 | (makunbound x)))) |
| 281 | ;; Delete the load-history element for this file. |
| 282 | (setq load-history (delq (assoc file load-history) load-history)))) |
| 283 | ;; Don't return load-history, it is not useful. |
| 284 | nil) |
| 285 | |
| 286 | (provide 'loadhist) |
| 287 | |
| 288 | ;;; loadhist.el ends here |