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 recent Emacsen, in which
  30 ;; case it does nothing.
  31
  32 ;;; Code:
  33
  34 (require 'package)
  35 (require 'find-func)
  36
  37 (unless (fboundp 'package--list-loaded-files)
  38
  39   (defun package--autoloads-file-name (pkg-desc)
  40     "Return the absolute name of the autoloads file, sans extension.
  41 PKG-DESC is a `package-desc' object."
  42     (expand-file-name
  43      (format "%s-autoloads" (package-desc-name pkg-desc))
  44      (package-desc-dir pkg-desc)))
  45
  46   (defun package--activate-autoloads-and-load-path (pkg-desc)
  47     "Load the autoloads file and add package dir to `load-path'.
  48 PKG-DESC is a `package-desc' object."
  49     (let* ((old-lp load-path)
  50            (pkg-dir (package-desc-dir pkg-desc))
  51            (pkg-dir-dir (file-name-as-directory pkg-dir)))
  52       (with-demoted-errors "Error loading autoloads: %s"
  53         (load (package--autoloads-file-name pkg-desc) nil t))
  54       (when (and (eq old-lp load-path)
  55                  (not (or (member pkg-dir load-path)
  56                           (member pkg-dir-dir load-path))))
  57         ;; Old packages don't add themselves to the `load-path', so we have to
  58         ;; do it ourselves.
  59         (push pkg-dir load-path))))
  60
  61   (defvar warning-minimum-level)
  62   (defun package--compile (pkg-desc)
  63     "Byte-compile installed package PKG-DESC."
  64     (let ((warning-minimum-level :error)
  65           (save-silently inhibit-message)
  66           (load-path load-path))
  67       (package--activate-autoloads-and-load-path pkg-desc)
  68       (byte-recompile-directory (package-desc-dir pkg-desc) 0 t)))
  69
  70   (defun package--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--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--list-loaded-files (package-desc-dir pkg-desc)))))
 111       ;; Add to load path, add autoloads, and activate the package.
 112       (package--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--autoloads-file-name pkg-desc))
 122                       loaded-files-list)))))
 123
 124   (defun package-activate-1 (pkg-desc &optional reload deps)
 125     "Activate package given by PKG-DESC, even if it was already active.
 126 If DEPS is non-nil, also activate its dependencies (unless they
 127 are already activated).
 128 If RELOAD is non-nil, also `load' any files inside the package which
 129 correspond to previously loaded files (those returned by
 130 `package--list-loaded-files')."
 131     (let* ((name (package-desc-name pkg-desc))
 132            (pkg-dir (package-desc-dir pkg-desc)))
 133       (unless pkg-dir
 134         (error "Internal error: unable to find directory for `%s'"
 135                (package-desc-full-name pkg-desc)))
 136       ;; Activate its dependencies recursively.
 137       ;; FIXME: This doesn't check whether the activated version is the
 138       ;; required version.
 139       (when deps
 140         (dolist (req (package-desc-reqs pkg-desc))
 141           (unless (package-activate (car req))
 142             (error "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable"
 143                    name (car req) (package-version-join (cadr req))))))
 144       (package--load-files-for-activation pkg-desc reload)
 145       ;; Add info node.
 146       (when (file-exists-p (expand-file-name "dir" pkg-dir))
 147         ;; FIXME: not the friendliest, but simple.
 148         (require 'info)
 149         (info-initialize)
 150         (push pkg-dir Info-directory-list))
 151       (push name package-activated-list)
 152       ;; Don't return nil.
 153       t))
 154
 155   (defun package-activate (package &optional force)
 156     "Activate the package named PACKAGE.
 157 If FORCE is true, (re-)activate it if it's already activated.
 158 Newer versions are always activated, regardless of FORCE."
 159     (let ((pkg-descs (cdr (assq package package-alist))))
 160       ;; Check if PACKAGE is available in `package-alist'.
 161       (while
 162           (when pkg-descs
 163             (let ((available-version (package-desc-version (car pkg-descs))))
 164               (or (package-disabled-p package available-version)
 165                   ;; Prefer a builtin package.
 166                   (package-built-in-p package available-version))))
 167         (setq pkg-descs (cdr pkg-descs)))
 168       (cond
 169        ;; If no such package is found, maybe it's built-in.
 170        ((null pkg-descs)
 171         (package-built-in-p package))
 172        ;; If the package is already activated, just return t.
 173        ((and (memq package package-activated-list) (not force))
 174         t)
 175        ;; Otherwise, proceed with activation.
 176        (t (package-activate-1 (car pkg-descs) nil 'deps)))))
 177
 178   (defun package-unpack (pkg-desc)
 179     "Install the contents of the current buffer as a package."
 180     (let* ((name (package-desc-name pkg-desc))
 181            (dirname (package-desc-full-name pkg-desc))
 182            (pkg-dir (expand-file-name dirname package-user-dir)))
 183       (pcase (package-desc-kind pkg-desc)
 184         (`dir
 185          (make-directory pkg-dir t)
 186          (let ((file-list
 187                 (directory-files
 188                  default-directory 'full "\\`[^.].*\\.el\\'" 'nosort)))
 189            (dolist (source-file file-list)
 190              (let ((target-el-file
 191                     (expand-file-name (file-name-nondirectory source-file) pkg-dir)))
 192                (copy-file source-file target-el-file t)))
 193            ;; Now that the files have been installed, this package is
 194            ;; indistinguishable from a `tar' or a `single'. Let's make
 195            ;; things simple by ensuring we're one of them.
 196            (setf (package-desc-kind pkg-desc)
 197                  (if (> (length file-list) 1) 'tar 'single))))
 198         (`tar
 199          (make-directory package-user-dir t)
 200          ;; FIXME: should we delete PKG-DIR if it exists?
 201          (let* ((default-directory (file-name-as-directory package-user-dir)))
 202            (package-untar-buffer dirname)))
 203         (`single
 204          (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir)))
 205            (make-directory pkg-dir t)
 206            (package--write-file-no-coding el-file)))
 207         (kind (error "Unknown package kind: %S" kind)))
 208       (package--make-autoloads-and-stuff pkg-desc pkg-dir)
 209       ;; Update package-alist.
 210       (let ((new-desc (package-load-descriptor pkg-dir)))
 211         ;; FIXME: Check that `new-desc' matches `desc'!
 212         ;; Activation has to be done before compilation, so that if we're
 213         ;; upgrading and macros have changed we load the new definitions
 214         ;; before compiling.
 215         (package-activate-1 new-desc :reload :deps)
 216         ;; FIXME: Compilation should be done as a separate, optional, step.
 217         ;; E.g. for multi-package installs, we should first install all packages
 218         ;; and then compile them.
 219         (package--compile new-desc)
 220         ;; After compilation, load again any files loaded by
 221         ;; `activate-1', so that we use the byte-compiled definitions.
 222         (package--load-files-for-activation new-desc :reload))
 223       pkg-dir))
 224
 225   )
 226
 227 (provide 'package-fixes)
 228 ;;; package-fixes.el ends here