code.delx.au - gnu-emacs-elpa/blob - packages/package-fixes/package-fixes.el

   1 ;;; package-fixes.el --- package.el bug fixes ported to older Emacsen  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
   4
   5 ;; Author: Artur Malabarba <emacs@endlessparentheses.com>
   6 ;; Keywords: tools
   7 ;; Version: 0
   8
   9 ;; This program is free software; you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; This program is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Commentary:
  23
  24 ;; This package fixes some critical bugs in package.el 1.0.1 which
  25 ;; cause bad .elc files to be created during package upgrades when a
  26 ;; macro changes.  It is designed to be required as a dependency by
  27 ;; packages whose installation is affected by these bugs.
  28
  29 ;; This package can be safely installed on Emacs >= 25, in which
  30 ;; case it does nothing.
  31
  32 ;;; Code:
  33
  34 \f
  35 ;;; Emacs < 25
  36 (unless (fboundp 'package--list-loaded-files)
  37   (require 'package)
  38   (require 'find-func)
  39
  40   (declare-function package-fixes--autoloads-file-name "package-fixes")
  41   (declare-function find-library-name "find-func")
  42   (declare-function package-fixes--list-loaded-files "package-fixes")
  43   (declare-function package-fixes--activate-autoloads-and-load-path "package-fixes")
  44
  45   ;; None of these functions are defined in Emacs < 25.1.  Defining
  46   ;; them here doesn't actually do anything yet, they will be used by
  47   ;; the advices below.
  48   (defun package-fixes--autoloads-file-name (pkg-desc)
  49     "Return the absolute name of the autoloads file, sans extension.
  50 PKG-DESC is a `package-desc' object."
  51     (expand-file-name
  52      (format "%s-autoloads" (package-desc-name pkg-desc))
  53      (package-desc-dir pkg-desc)))
  54
  55   (defun package-fixes--activate-autoloads-and-load-path (pkg-desc)
  56     "Load the autoloads file and add package dir to `load-path'.
  57 PKG-DESC is a `package-desc' object."
  58     (let* ((old-lp load-path)
  59            (pkg-dir (package-desc-dir pkg-desc))
  60            (pkg-dir-dir (file-name-as-directory pkg-dir)))
  61       (with-demoted-errors "Error loading autoloads: %s"
  62         (load (package-fixes--autoloads-file-name pkg-desc) nil t))
  63       (when (and (eq old-lp load-path)
  64                  (not (or (member pkg-dir load-path)
  65                           (member pkg-dir-dir load-path))))
  66         ;; Old packages don't add themselves to the `load-path', so we have to
  67         ;; do it ourselves.
  68         (push pkg-dir load-path))))
  69
  70   (defun package-fixes--list-loaded-files (dir)
  71     "Recursively list all files in DIR which correspond to loaded features.
  72 Returns the `file-name-sans-extension' of each file, relative to
  73 DIR, sorted by most recently loaded last."
  74     (let* ((history (delq nil
  75                           (mapcar (lambda (x)
  76                                     (let ((f (car x)))
  77                                       (and f (file-name-sans-extension f))))
  78                                   load-history)))
  79            (dir (file-truename dir))
  80            ;; List all files that have already been loaded.
  81            (list-of-conflicts
  82             (delq
  83              nil
  84              (mapcar
  85               (lambda (x) (let* ((file (file-relative-name x dir))
  86                             ;; Previously loaded file, if any.
  87                             (previous
  88                              (ignore-errors
  89                                (file-name-sans-extension
  90                                 (file-truename (find-library-name file)))))
  91                             (pos (when previous (member previous history))))
  92                        ;; Return (RELATIVE-FILENAME . HISTORY-POSITION)
  93                        (when pos
  94                          (cons (file-name-sans-extension file) (length pos)))))
  95               (directory-files-recursively dir "\\`[^\\.].*\\.el\\'")))))
  96       ;; Turn the list of (FILENAME . POS) back into a list of features.  Files in
  97       ;; subdirectories are returned relative to DIR (so not actually features).
  98       (let ((default-directory (file-name-as-directory dir)))
  99         (mapcar (lambda (x) (file-truename (car x)))
 100                 (sort list-of-conflicts
 101                       ;; Sort the files by ascending HISTORY-POSITION.
 102                       (lambda (x y) (< (cdr x) (cdr y))))))))
 103
 104   (defun package-fixes--load-files-for-activation (pkg-desc reload)
 105     "Load files for activating a package given by PKG-DESC.
 106 Load the autoloads file, and ensure `load-path' is setup.  If
 107 RELOAD is non-nil, also load all files in the package that
 108 correspond to previously loaded files."
 109     (let* ((loaded-files-list (when reload
 110                                 (package-fixes--list-loaded-files (package-desc-dir pkg-desc)))))
 111       ;; Add to load path, add autoloads, and activate the package.
 112       (package-fixes--activate-autoloads-and-load-path pkg-desc)
 113       ;; Call `load' on all files in `package-desc-dir' already present in
 114       ;; `load-history'.  This is done so that macros in these files are updated
 115       ;; to their new definitions.  If another package is being installed which
 116       ;; depends on this new definition, not doing this update would cause
 117       ;; compilation errors and break the installation.
 118       (with-demoted-errors "Error in package--load-files-for-activation: %s"
 119         (mapc (lambda (feature) (load feature nil t))
 120               ;; Skip autoloads file since we already evaluated it above.
 121               (remove (file-truename (package-fixes--autoloads-file-name pkg-desc))
 122                       loaded-files-list)))))
 123
 124   \f
 125 ;;; 24.1, 24.2, 24.3
 126   (defadvice package--make-autoloads-and-compile (around fix-package--make-autoloads-and-compile
 127                                                          (name pkg-dir) activate)
 128     "Fixed `package--make-autoloads-and-compile'.
 129 Behave the same as `package--make-autoloads-and-compile', except
 130 it uses `package-fixes--load-files-for-activation' instead of just
 131 loading the autoloads file."
 132     (package-generate-autoloads name pkg-dir)
 133     (package-fixes--load-files-for-activation pkg-desc :reload)
 134     (let ((load-path (cons pkg-dir load-path)))
 135       ;; We must load the autoloads file before byte compiling, in
 136       ;; case there are magic cookies to set up non-trivial paths.
 137       (byte-recompile-directory pkg-dir 0 t)))
 138
 139 ;;; 24.4, 24.5
 140   (defadvice package--compile (after fix-package--compile (pkg-desc) activate)
 141     "Like `package--compile', but reload package first.
 142 Uses `package-fixes--load-files-for-activation' to reload files."
 143     (package-activate-1 pkg-desc)
 144     (package-fixes--load-files-for-activation pkg-desc :reload)
 145     (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
 146
 147 (provide 'package-fixes)
 148 ;;; package-fixes.el ends here