LCOV - code coverage report
Current view: top level - lisp - loadhist.el (source / functions) Hit Total Coverage
Test: tramp-tests.info Lines: 87 112 77.7 %
Date: 2017-08-27 09:44:50 Functions: 15 22 68.2 %

          Line data    Source code
       1             : ;;; loadhist.el --- lisp functions for working with feature groups
       2             : 
       3             : ;; Copyright (C) 1995, 1998, 2000-2017 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           6 :   (catch 'foundit
      37           6 :     (let ((element (cons 'provide feature)))
      38           6 :       (dolist (x load-history nil)
      39          49 :         (when (member element (cdr x))
      40          43 :           (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           2 :   (if (not (featurep feature))
      48           0 :       (error "%S is not a currently loaded feature" feature)
      49           2 :     (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         748 :   (let ((symbols (assoc file load-history)))
      57             :     ;; Try converting a library name to an absolute file name.
      58         748 :     (and (null symbols)
      59           0 :          (let ((absname
      60           0 :                 (locate-file file load-path (get-load-suffixes))))
      61           0 :            (and absname (not (equal absname file))
      62         748 :                 (setq symbols (cdr (assoc absname load-history))))))
      63         748 :     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           2 :   (let (provides)
      70           2 :     (dolist (x (file-loadhist-lookup file) provides)
      71           4 :       (when (eq (car-safe x) 'provide)
      72           4 :         (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         746 :   (let (requires)
      79         746 :     (dolist (x (file-loadhist-lookup file) requires)
      80       57578 :       (when (eq (car-safe x) 'require)
      81       57578 :         (push (cdr x) requires)))))
      82             : 
      83             : (defsubst file-set-intersect (p q)
      84             :   "Return the set intersection of two lists."
      85         746 :   (let (ret)
      86         746 :     (dolist (x p ret)
      87         746 :       (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           2 :   (let ((provides (file-provides file))
      95             :         (dependents nil))
      96           2 :     (dolist (x load-history dependents)
      97         746 :       (when (file-set-intersect provides (file-requires (car x)))
      98         746 :         (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           0 :   (intern (completing-read
     105           0 :            prompt
     106           0 :            (mapcar #'symbol-name
     107           0 :                    (if loaded-p
     108           0 :                        (delq nil
     109           0 :                              (mapcar
     110           0 :                               (lambda (x) (and (feature-file x) x))
     111           0 :                               features))
     112           0 :                      features)))))
     113             : 
     114             : (defvaralias 'loadhist-hook-functions 'unload-feature-special-hooks)
     115             : (defvar unload-feature-special-hooks
     116             :   '(after-change-functions after-insert-file-functions
     117             :     after-make-frame-functions auto-coding-functions
     118             :     auto-fill-function before-change-functions
     119             :     blink-paren-function buffer-access-fontify-functions
     120             :     choose-completion-string-functions
     121             :     comint-output-filter-functions command-line-functions
     122             :     comment-indent-function compilation-finish-functions
     123             :     delete-frame-functions disabled-command-function
     124             :     fill-nobreak-predicate find-directory-functions
     125             :     find-file-not-found-functions
     126             :     font-lock-fontify-buffer-function
     127             :     font-lock-fontify-region-function
     128             :     font-lock-mark-block-function
     129             :     font-lock-syntactic-face-function
     130             :     font-lock-unfontify-buffer-function
     131             :     font-lock-unfontify-region-function
     132             :     kill-buffer-query-functions kill-emacs-query-functions
     133             :     lisp-indent-function mouse-position-function
     134             :     redisplay-end-trigger-functions suspend-tty-functions
     135             :     temp-buffer-show-function window-scroll-functions
     136             :     window-size-change-functions write-contents-functions
     137             :     write-file-functions write-region-annotate-functions)
     138             :   "A list of special hooks from Info node `(elisp)Standard Hooks'.
     139             : 
     140             : These are symbols with hooklike values whose names don't end in
     141             : `-hook' or `-hooks', from which `unload-feature' should try to remove
     142             : pertinent symbols.")
     143             : 
     144             : (define-obsolete-variable-alias 'unload-hook-features-list
     145             :     'unload-function-defs-list "22.2")
     146             : (defvar unload-function-defs-list nil
     147             :   "List of definitions in the Lisp library being unloaded.
     148             : 
     149             : This is meant to be used by `FEATURE-unload-function'; see the
     150             : documentation of `unload-feature' for details.")
     151             : 
     152             : (defun unload--set-major-mode ()
     153           3 :   (save-current-buffer
     154           3 :     (dolist (buffer (buffer-list))
     155         581 :       (set-buffer buffer)
     156         581 :       (let ((proposed major-mode))
     157             :         ;; Look for a predecessor mode not defined in the feature we're processing
     158         581 :         (while (and proposed (rassq proposed unload-function-defs-list))
     159         581 :           (setq proposed (get proposed 'derived-mode-parent)))
     160         581 :         (unless (eq proposed major-mode)
     161             :           ;; Two cases: either proposed is nil, and we want to switch to fundamental
     162             :           ;; mode, or proposed is not nil and not major-mode, and so we use it.
     163         581 :           (funcall (or proposed 'fundamental-mode)))))))
     164             : 
     165             : (cl-defgeneric loadhist-unload-element (x)
     166             :   "Unload an element from the `load-history'."
     167             :   (message "Unexpected element %S in load-history" x))
     168             : 
     169             : ;; In `load-history', the definition of a previously autoloaded
     170             : ;; function is represented by 2 entries: (t . SYMBOL) comes before
     171             : ;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when
     172             : ;; we undefine it.
     173             : ;; So we use this auxiliary variable to keep track of the last (t . SYMBOL)
     174             : ;; that occurred.
     175             : (defvar loadhist--restore-autoload
     176             :   "If non-nil, this is a symbol for which we should
     177             : restore a previous autoload if possible.")
     178             : 
     179             : (cl-defmethod loadhist-unload-element ((x (head t)))
     180           0 :   (setq loadhist--restore-autoload (cdr x)))
     181             : 
     182             : (defun loadhist--unload-function (x)
     183          42 :   (let ((fun (cdr x)))
     184          42 :     (when (fboundp fun)
     185          42 :       (when (fboundp 'ad-unadvise)
     186          42 :         (ad-unadvise fun))
     187          42 :       (let ((aload (get fun 'autoload)))
     188          42 :         (defalias fun
     189          42 :           (if (and aload (eq fun loadhist--restore-autoload))
     190           0 :               (cons 'autoload aload)
     191          42 :             nil)))))
     192          42 :   (setq loadhist--restore-autoload nil))
     193             : 
     194             : (cl-defmethod loadhist-unload-element ((x (head defun)))
     195          42 :   (loadhist--unload-function x))
     196             : (cl-defmethod loadhist-unload-element ((x (head autoload)))
     197           0 :   (loadhist--unload-function x))
     198             : 
     199             : (cl-defmethod loadhist-unload-element ((_ (head require))) nil)
     200             : (cl-defmethod loadhist-unload-element ((_ (head defface))) nil)
     201             : 
     202             : (cl-defmethod loadhist-unload-element ((x (head provide)))
     203             :   ;; Remove any feature names that this file provided.
     204           3 :   (setq features (delq (cdr x) features)))
     205             : 
     206             : (cl-defmethod loadhist-unload-element ((x symbol))
     207             :   ;; Kill local values as much as possible.
     208          24 :   (dolist (buf (buffer-list))
     209        4632 :     (with-current-buffer buf
     210        4632 :       (if (and (boundp x) (timerp (symbol-value x)))
     211        4632 :           (cancel-timer (symbol-value x)))
     212        4632 :       (kill-local-variable x)))
     213          24 :   (if (and (boundp x) (timerp (symbol-value x)))
     214          24 :       (cancel-timer (symbol-value x)))
     215             :   ;; Get rid of the default binding if we can.
     216          24 :   (unless (local-variable-if-set-p x)
     217          24 :     (makunbound x)))
     218             : 
     219             : (cl-defmethod loadhist-unload-element ((x (head define-type)))
     220           0 :   (let* ((name (cdr x)))
     221             :     ;; Remove the struct.
     222           0 :     (setf (cl--find-class name) nil)))
     223             : 
     224             : (cl-defmethod loadhist-unload-element ((x (head define-symbol-props)))
     225           0 :   (pcase-dolist (`(,symbol . ,props) (cdr x))
     226           0 :     (dolist (prop props)
     227           0 :       (put symbol prop nil))))
     228             : 
     229             : ;;;###autoload
     230             : (defun unload-feature (feature &optional force)
     231             :   "Unload the library that provided FEATURE.
     232             : If the feature is required by any other loaded code, and prefix arg FORCE
     233             : is nil, raise an error.
     234             : 
     235             : Standard unloading activities include restoring old autoloads for
     236             : functions defined by the library, undoing any additions that the
     237             : library has made to hook variables or to `auto-mode-alist', undoing
     238             : ELP profiling of functions in that library, unproviding any features
     239             : provided by the library, and canceling timers held in variables
     240             : defined by the library.
     241             : 
     242             : If a function `FEATURE-unload-function' is defined, this function
     243             : calls it with no arguments, before doing anything else.  That function
     244             : can do whatever is appropriate to undo the loading of the library.  If
     245             : `FEATURE-unload-function' returns non-nil, that suppresses the
     246             : standard unloading of the library.  Otherwise the standard unloading
     247             : proceeds.
     248             : 
     249             : `FEATURE-unload-function' has access to the package's list of
     250             : definitions in the variable `unload-function-defs-list' and could
     251             : remove symbols from it in the event that the package has done
     252             : something strange, such as redefining an Emacs function."
     253             :   (interactive
     254           0 :    (list
     255           0 :     (read-feature "Unload feature: " t)
     256           0 :     current-prefix-arg))
     257           5 :   (unless (featurep feature)
     258           4 :     (error "%s is not a currently loaded feature" (symbol-name feature)))
     259           4 :   (unless force
     260           2 :     (let* ((file (feature-file feature))
     261           2 :            (dependents (delete file (copy-sequence (file-dependents file)))))
     262           2 :       (when dependents
     263           0 :         (error "Loaded libraries %s depend on %s"
     264           4 :                (prin1-to-string dependents) file))))
     265           4 :   (let* ((unload-function-defs-list (feature-symbols feature))
     266           8 :          (file (pop unload-function-defs-list))
     267           4 :          (name (symbol-name feature))
     268           4 :          (unload-hook (intern-soft (concat name "-unload-hook")))
     269           4 :          (unload-func (intern-soft (concat name "-unload-function"))))
     270             :     ;; If FEATURE-unload-function is defined and returns non-nil,
     271             :     ;; don't try to do anything more; otherwise proceed normally.
     272           4 :     (unless (and (fboundp unload-func)
     273           4 :                  (funcall unload-func))
     274             :       ;; Try to avoid losing badly when hooks installed in critical
     275             :       ;; places go away.  (Some packages install things on
     276             :       ;; `kill-buffer-hook', `activate-menubar-hook' and the like.)
     277           4 :       (if unload-hook
     278             :           ;; First off, provide a clean way for package FOO to arrange
     279             :           ;; this by adding hooks on the variable `FOO-unload-hook'.
     280             :           ;; This is obsolete; FEATURE-unload-function should be used now.
     281           1 :           (run-hooks unload-hook)
     282             :         ;; Otherwise, do our best.  Look through the obarray for symbols
     283             :         ;; which seem to be hook variables or special hook functions and
     284             :         ;; remove anything from them which matches the feature-symbols
     285             :         ;; about to get zapped.  Obviously this won't get anonymous
     286             :         ;; functions which the package might just have installed, and
     287             :         ;; there might be other important state, but this tactic
     288             :         ;; normally works.
     289           3 :         (mapatoms
     290             :          (lambda (x)
     291       80571 :            (when (and (boundp x)
     292       13680 :                       (or (and (consp (symbol-value x)) ; Random hooks.
     293       13680 :                                (string-match "-hooks?\\'" (symbol-name x)))
     294       80571 :                           (memq x unload-feature-special-hooks)))       ; Known abnormal hooks etc.
     295         232 :              (dolist (y unload-function-defs-list)
     296        5536 :                (when (and (eq (car-safe y) 'defun)
     297        5536 :                           (not (get (cdr y) 'autoload)))
     298       80574 :                  (remove-hook x (cdr y)))))))
     299             :         ;; Remove any feature-symbols from auto-mode-alist as well.
     300           3 :         (dolist (y unload-function-defs-list)
     301          71 :           (when (and (eq (car-safe y) 'defun)
     302          71 :                      (not (get (cdr y) 'autoload)))
     303          41 :             (setq auto-mode-alist
     304          71 :                   (rassq-delete-all (cdr y) auto-mode-alist)))))
     305             : 
     306             :       ;; Change major mode in all buffers using one defined in the feature being unloaded.
     307           3 :       (unload--set-major-mode)
     308             : 
     309           3 :       (mapc #'loadhist-unload-element unload-function-defs-list)
     310             :       ;; Delete the load-history element for this file.
     311           3 :       (setq load-history (delq (assoc file load-history) load-history))))
     312             :   ;; Don't return load-history, it is not useful.
     313             :   nil)
     314             : 
     315             : (provide 'loadhist)
     316             : 
     317             : ;;; loadhist.el ends here

Generated by: LCOV version 1.12