From 11c3943fee7a2b6b541700c5f28994034e27f4c2 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 1 Dec 2015 16:19:20 +0000 Subject: [PATCH] * packages/package-fixes: New package (not yet released) --- packages/package-fixes/package-fixes.el | 228 ++++++++++++++++++++++++ 1 file changed, 228 insertions(+) create mode 100644 packages/package-fixes/package-fixes.el diff --git a/packages/package-fixes/package-fixes.el b/packages/package-fixes/package-fixes.el new file mode 100644 index 000000000..d48023245 --- /dev/null +++ b/packages/package-fixes/package-fixes.el @@ -0,0 +1,228 @@ +;;; package-fixes.el --- package.el bug fixes ported to older Emacsen -*- lexical-binding: t; -*- + +;; Copyright (C) 2015 Free Software Foundation, Inc. + +;; Author: Artur Malabarba +;; Keywords: tools +;; Version: 0 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package fixes some critical bugs in package.el 1.0.1 which +;; cause bad .elc files to be created during package upgrades when a +;; macro changes. It is designed to be required as a dependency by +;; packages whose installation is affected by these bugs. + +;; This package can be safely installed on recent Emacsen, in which +;; case it does nothing. + +;;; Code: + +(require 'package) +(require 'find-func) + +(unless (fboundp 'package--list-loaded-files) + + (defun package--autoloads-file-name (pkg-desc) + "Return the absolute name of the autoloads file, sans extension. +PKG-DESC is a `package-desc' object." + (expand-file-name + (format "%s-autoloads" (package-desc-name pkg-desc)) + (package-desc-dir pkg-desc))) + + (defun package--activate-autoloads-and-load-path (pkg-desc) + "Load the autoloads file and add package dir to `load-path'. +PKG-DESC is a `package-desc' object." + (let* ((old-lp load-path) + (pkg-dir (package-desc-dir pkg-desc)) + (pkg-dir-dir (file-name-as-directory pkg-dir))) + (with-demoted-errors "Error loading autoloads: %s" + (load (package--autoloads-file-name pkg-desc) nil t)) + (when (and (eq old-lp load-path) + (not (or (member pkg-dir load-path) + (member pkg-dir-dir load-path)))) + ;; Old packages don't add themselves to the `load-path', so we have to + ;; do it ourselves. + (push pkg-dir load-path)))) + + (defvar warning-minimum-level) + (defun package--compile (pkg-desc) + "Byte-compile installed package PKG-DESC." + (let ((warning-minimum-level :error) + (save-silently inhibit-message) + (load-path load-path)) + (package--activate-autoloads-and-load-path pkg-desc) + (byte-recompile-directory (package-desc-dir pkg-desc) 0 t))) + + (defun package--list-loaded-files (dir) + "Recursively list all files in DIR which correspond to loaded features. +Returns the `file-name-sans-extension' of each file, relative to +DIR, sorted by most recently loaded last." + (let* ((history (delq nil + (mapcar (lambda (x) + (let ((f (car x))) + (and f (file-name-sans-extension f)))) + load-history))) + (dir (file-truename dir)) + ;; List all files that have already been loaded. + (list-of-conflicts + (delq + nil + (mapcar + (lambda (x) (let* ((file (file-relative-name x dir)) + ;; Previously loaded file, if any. + (previous + (ignore-errors + (file-name-sans-extension + (file-truename (find-library-name file))))) + (pos (when previous (member previous history)))) + ;; Return (RELATIVE-FILENAME . HISTORY-POSITION) + (when pos + (cons (file-name-sans-extension file) (length pos))))) + (directory-files-recursively dir "\\`[^\\.].*\\.el\\'"))))) + ;; Turn the list of (FILENAME . POS) back into a list of features. Files in + ;; subdirectories are returned relative to DIR (so not actually features). + (let ((default-directory (file-name-as-directory dir))) + (mapcar (lambda (x) (file-truename (car x))) + (sort list-of-conflicts + ;; Sort the files by ascending HISTORY-POSITION. + (lambda (x y) (< (cdr x) (cdr y)))))))) + + (defun package--load-files-for-activation (pkg-desc reload) + "Load files for activating a package given by PKG-DESC. +Load the autoloads file, and ensure `load-path' is setup. If +RELOAD is non-nil, also load all files in the package that +correspond to previously loaded files." + (let* ((loaded-files-list (when reload + (package--list-loaded-files (package-desc-dir pkg-desc))))) + ;; Add to load path, add autoloads, and activate the package. + (package--activate-autoloads-and-load-path pkg-desc) + ;; Call `load' on all files in `package-desc-dir' already present in + ;; `load-history'. This is done so that macros in these files are updated + ;; to their new definitions. If another package is being installed which + ;; depends on this new definition, not doing this update would cause + ;; compilation errors and break the installation. + (with-demoted-errors "Error in package--load-files-for-activation: %s" + (mapc (lambda (feature) (load feature nil t)) + ;; Skip autoloads file since we already evaluated it above. + (remove (file-truename (package--autoloads-file-name pkg-desc)) + loaded-files-list))))) + + (defun package-activate-1 (pkg-desc &optional reload deps) + "Activate package given by PKG-DESC, even if it was already active. +If DEPS is non-nil, also activate its dependencies (unless they +are already activated). +If RELOAD is non-nil, also `load' any files inside the package which +correspond to previously loaded files (those returned by +`package--list-loaded-files')." + (let* ((name (package-desc-name pkg-desc)) + (pkg-dir (package-desc-dir pkg-desc))) + (unless pkg-dir + (error "Internal error: unable to find directory for `%s'" + (package-desc-full-name pkg-desc))) + ;; Activate its dependencies recursively. + ;; FIXME: This doesn't check whether the activated version is the + ;; required version. + (when deps + (dolist (req (package-desc-reqs pkg-desc)) + (unless (package-activate (car req)) + (error "Unable to activate package `%s'.\nRequired package `%s-%s' is unavailable" + name (car req) (package-version-join (cadr req)))))) + (package--load-files-for-activation pkg-desc reload) + ;; Add info node. + (when (file-exists-p (expand-file-name "dir" pkg-dir)) + ;; FIXME: not the friendliest, but simple. + (require 'info) + (info-initialize) + (push pkg-dir Info-directory-list)) + (push name package-activated-list) + ;; Don't return nil. + t)) + + (defun package-activate (package &optional force) + "Activate the package named PACKAGE. +If FORCE is true, (re-)activate it if it's already activated. +Newer versions are always activated, regardless of FORCE." + (let ((pkg-descs (cdr (assq package package-alist)))) + ;; Check if PACKAGE is available in `package-alist'. + (while + (when pkg-descs + (let ((available-version (package-desc-version (car pkg-descs)))) + (or (package-disabled-p package available-version) + ;; Prefer a builtin package. + (package-built-in-p package available-version)))) + (setq pkg-descs (cdr pkg-descs))) + (cond + ;; If no such package is found, maybe it's built-in. + ((null pkg-descs) + (package-built-in-p package)) + ;; If the package is already activated, just return t. + ((and (memq package package-activated-list) (not force)) + t) + ;; Otherwise, proceed with activation. + (t (package-activate-1 (car pkg-descs) nil 'deps))))) + + (defun package-unpack (pkg-desc) + "Install the contents of the current buffer as a package." + (let* ((name (package-desc-name pkg-desc)) + (dirname (package-desc-full-name pkg-desc)) + (pkg-dir (expand-file-name dirname package-user-dir))) + (pcase (package-desc-kind pkg-desc) + (`dir + (make-directory pkg-dir t) + (let ((file-list + (directory-files + default-directory 'full "\\`[^.].*\\.el\\'" 'nosort))) + (dolist (source-file file-list) + (let ((target-el-file + (expand-file-name (file-name-nondirectory source-file) pkg-dir))) + (copy-file source-file target-el-file t))) + ;; Now that the files have been installed, this package is + ;; indistinguishable from a `tar' or a `single'. Let's make + ;; things simple by ensuring we're one of them. + (setf (package-desc-kind pkg-desc) + (if (> (length file-list) 1) 'tar 'single)))) + (`tar + (make-directory package-user-dir t) + ;; FIXME: should we delete PKG-DIR if it exists? + (let* ((default-directory (file-name-as-directory package-user-dir))) + (package-untar-buffer dirname))) + (`single + (let ((el-file (expand-file-name (format "%s.el" name) pkg-dir))) + (make-directory pkg-dir t) + (package--write-file-no-coding el-file))) + (kind (error "Unknown package kind: %S" kind))) + (package--make-autoloads-and-stuff pkg-desc pkg-dir) + ;; Update package-alist. + (let ((new-desc (package-load-descriptor pkg-dir))) + ;; FIXME: Check that `new-desc' matches `desc'! + ;; Activation has to be done before compilation, so that if we're + ;; upgrading and macros have changed we load the new definitions + ;; before compiling. + (package-activate-1 new-desc :reload :deps) + ;; FIXME: Compilation should be done as a separate, optional, step. + ;; E.g. for multi-package installs, we should first install all packages + ;; and then compile them. + (package--compile new-desc) + ;; After compilation, load again any files loaded by + ;; `activate-1', so that we use the byte-compiled definitions. + (package--load-files-for-activation new-desc :reload)) + pkg-dir)) + + ) + +(provide 'package-fixes) +;;; package-fixes.el ends here -- 2.39.2