[elpa] scratch/package-fixes.el 572e110: * packages/package-fixes: New package

[Artur Malabarba]

branch: scratch/package-fixes.el
commit 572e110e5a86965ea79bac57c9ffe3b336686527
Author: Artur Malabarba <address@hidden>
Commit: Artur Malabarba <address@hidden>

    * packages/package-fixes: New package
---
 packages/package-fixes/package-fixes.el            |  139 ++++++++++++++++++++
 packages/package-fixes/tests/script.el             |   11 ++
 .../package-fixes/tests/test-package-1.0/my.el     |   40 ++++++
 .../package-fixes/tests/test-package-1.0/na.el     |   31 +++++
 .../package-fixes/tests/test-package-2.0/my.el     |   49 +++++++
 .../package-fixes/tests/test-package-2.0/na.el     |   35 +++++
 6 files changed, 305 insertions(+), 0 deletions(-)

diff --git a/packages/package-fixes/package-fixes.el 
b/packages/package-fixes/package-fixes.el
new file mode 100644
index 0000000..3b3e24f
--- /dev/null
+++ b/packages/package-fixes/package-fixes.el
@@ -0,0 +1,139 @@
+;;; package-fixes.el --- package.el bug fixes ported to older Emacsen  -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; Author: Artur Malabarba <address@hidden>
+;; Keywords: tools
+;; Version: 0.1
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; 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-activate-1 (pkg-desc &optional reload)
+    "Activate package given by PKG-DESC, even if it was already active.
+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)))
+      (let* ((loaded-files-list (when reload
+                                  (package--list-loaded-files pkg-dir))))
+        ;; Add to load path, add autoloads, and activate the package.
+        (package--activate-autoloads-and-load-path pkg-desc)
+        ;; Call `load' on all files in `pkg-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-activate-1: %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))))
+      ;; 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)))
+
+(provide 'package-fixes)
+;;; package-fixes.el ends here
diff --git a/packages/package-fixes/tests/script.el 
b/packages/package-fixes/tests/script.el
new file mode 100644
index 0000000..6828030
--- /dev/null
+++ b/packages/package-fixes/tests/script.el
@@ -0,0 +1,11 @@
+;; This buffer is for notes you don’t want to save, and for Lisp evaluation.
+;; If you want to create a file, visit that file with C-x C-f,
+;; then enter the text in that file’s own buffer.
+(require 'package)
+(setq package-user-dir "~/fake--elpa")
+(package-install-file "test-package-1.0/")
+(require 'my)
+(my-func) ;; (progn a b)
+(package-install-file "test-package-2.0/")
+(my-func)
+
diff --git a/packages/package-fixes/tests/test-package-1.0/my.el 
b/packages/package-fixes/tests/test-package-1.0/my.el
new file mode 100644
index 0000000..a694d28
--- /dev/null
+++ b/packages/package-fixes/tests/test-package-1.0/my.el
@@ -0,0 +1,40 @@
+;;; my.el --- laksd                                  -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2015  Artur Malabarba
+
+;; Author: Artur Malabarba <address@hidden>
+;; Keywords: tools
+;; Version: 1.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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(require 'na)
+
+(defmacro my-1 ( &rest forms)
+  "Description"
+  `(progn ,@forms))
+
+(defun my-func ()
+  ""
+  (my-1 'a 'b)
+  (na-1 'a 'b))
+
+(provide 'my)
+;;; my.el ends here
diff --git a/packages/package-fixes/tests/test-package-1.0/na.el 
b/packages/package-fixes/tests/test-package-1.0/na.el
new file mode 100644
index 0000000..da07d9a
--- /dev/null
+++ b/packages/package-fixes/tests/test-package-1.0/na.el
@@ -0,0 +1,31 @@
+;;; na.el --- laksd                                  -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2015  Artur Malabarba
+
+;; Author: Artur Malabarba <address@hidden>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(defun na-1 ( &rest forms)
+  "Description"
+  `(progn ,@forms))
+
+(provide 'na)
+;;; na.el ends here
diff --git a/packages/package-fixes/tests/test-package-2.0/my.el 
b/packages/package-fixes/tests/test-package-2.0/my.el
new file mode 100644
index 0000000..7e8d2a9
--- /dev/null
+++ b/packages/package-fixes/tests/test-package-2.0/my.el
@@ -0,0 +1,49 @@
+;;; my.el --- laksd                                  -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2015  Artur Malabarba
+
+;; Author: Artur Malabarba <address@hidden>
+;; Keywords: tools
+;; Version: 2.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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(require 'na)
+
+(defmacro my-1 ( &rest forms)
+  "Description"
+  `(progn ,(cadr (car forms))))
+
+
+(defun my-func ()
+  ""
+  (list (my-1 '1 'b)
+        (na-1 'a 'b)))
+
+(defmacro my-3 (&rest _)
+  "Description"
+  10)
+
+(defun 10-and-90 ()
+  ""
+  (list (my-3 haha) (na-3 hehe)))
+
+(provide 'my)
+;;; my.el ends here
diff --git a/packages/package-fixes/tests/test-package-2.0/na.el 
b/packages/package-fixes/tests/test-package-2.0/na.el
new file mode 100644
index 0000000..067c2f1
--- /dev/null
+++ b/packages/package-fixes/tests/test-package-2.0/na.el
@@ -0,0 +1,35 @@
+;;; na.el --- laksd                                  -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2015  Artur Malabarba
+
+;; Author: Artur Malabarba <address@hidden>
+
+;; 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 <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; 
+
+;;; Code:
+
+(defmacro na-1 ( &rest forms)
+  "Description"
+  `(progn ,@forms))
+
+(defmacro na-3 ( &rest _)
+  "Description"
+  90)
+
+(provide 'na)
+;;; na.el ends here