[Emacs-diffs] master ca66737 2/2: * lisp/emacs-lisp/package.el: Many small changes

[Artur Malabarba]

branch: master
commit ca66737c5313665a1646a64de8fa6181c9e11de5
Author: Artur Malabarba <address@hidden>
Commit: Artur Malabarba <address@hidden>

    * lisp/emacs-lisp/package.el: Many small changes
    
    Replace all instances of 'face with 'font-lock-face.
    (describe-package-1): Improve some strings and move the summary up the
    list.
    (package-install-file): Update docstring.
    (package-menu-hide-package): Bind to `H'.
---
 lisp/emacs-lisp/package.el     |   43 +++++++++++++++++++++++----------------
 test/automated/package-test.el |   18 +++++++---------
 2 files changed, 33 insertions(+), 28 deletions(-)

diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
index fc5ef0b..c7e3096 100644
--- a/lisp/emacs-lisp/package.el
+++ b/lisp/emacs-lisp/package.el
@@ -1956,7 +1956,8 @@ Downloads and installs required packages as needed."
 ;;;###autoload
 (defun package-install-file (file)
   "Install a package from a file.
-The file can either be a tar file or an Emacs Lisp file."
+The file can either be a tar file, an Emacs Lisp file, or a
+directory."
   (interactive "fPackage file name: ")
   (with-temp-buffer
     (if (file-directory-p file)
@@ -2163,6 +2164,8 @@ will be deleted."
          (status (if desc (package-desc-status desc) "orphan"))
          (incompatible-reason (package--incompatible-p desc))
          (signed (if desc (package-desc-signed desc))))
+    (when (string= status "avail-obso")
+      (setq status "available obsolete"))
     (when incompatible-reason
       (setq status "incompatible"))
     (prin1 name)
@@ -2179,13 +2182,15 @@ will be deleted."
           (pkg-dir
            (insert (propertize (if (member status '("unsigned" "dependency"))
                                    "Installed"
-                                 (capitalize status)) ;FIXME: Why comment-face?
-                               'font-lock-face 'font-lock-comment-face))
+                                 (capitalize status))
+                               'font-lock-face 'font-lock-builtin-face))
            (insert (substitute-command-keys " in ‘"))
-           ;; Todo: Add button for uninstalling.
-           (help-insert-xref-button (abbreviate-file-name
-                                     (file-name-as-directory pkg-dir))
-                                    'help-package-def pkg-dir)
+           (let ((dir (abbreviate-file-name
+                       (file-name-as-directory
+                        (if (file-in-directory-p pkg-dir package-user-dir)
+                            (file-relative-name pkg-dir package-user-dir)
+                          pkg-dir)))))
+             (help-insert-xref-button dir 'help-package-def pkg-dir))
            (if (and (package-built-in-p name)
                     (not (package-built-in-p name version)))
                (insert (substitute-command-keys
@@ -2198,13 +2203,13 @@ will be deleted."
              (insert " (unsigned)."))
            (when (and (package-desc-p desc)
                       (not required-by)
-                      (package-installed-p desc))
+                      (member status '("unsigned" "installed")))
              (insert " ")
              (package-make-button "Delete"
                                   'action #'package-delete-button-action
                                   'package-desc desc)))
           (incompatible-reason
-           (insert (propertize "Incompatible" 'face font-lock-warning-face)
+           (insert (propertize "Incompatible" 'font-lock-face 
font-lock-warning-face)
                    " because it depends on ")
            (if (stringp incompatible-reason)
                (insert "Emacs " incompatible-reason ".")
@@ -2219,12 +2224,15 @@ will be deleted."
             'package-desc desc))
           (t (insert (capitalize status) ".")))
     (insert "\n")
-    (insert "    " (propertize "Archive" 'font-lock-face 'bold)
-            ": " (or archive "n/a") "\n")
+    (unless (and pkg-dir (not archive)) ; Installed pkgs don't have archive.
+      (insert "    " (propertize "Archive" 'font-lock-face 'bold)
+              ": " (or archive "n/a") "\n"))
     (and version
          (insert "    "
                  (propertize "Version" 'font-lock-face 'bold) ": "
                  (package-version-join version) "\n"))
+    (insert "    " (propertize "Summary" 'font-lock-face 'bold)
+            ": " (if desc (package-desc-summary desc)) "\n")
 
     (setq reqs (if desc (package-desc-reqs desc)))
     (when reqs
@@ -2259,8 +2267,6 @@ will be deleted."
             (help-insert-xref-button text 'help-package
                                      (package-desc-name pkg))))
         (insert "\n")))
-    (insert "    " (propertize "Summary" 'font-lock-face 'bold)
-            ": " (if desc (package-desc-summary desc)) "\n")
     (when homepage
       (insert "   " (propertize "Homepage" 'font-lock-face 'bold) ": ")
       (help-insert-xref-button homepage 'help-url homepage)
@@ -2290,7 +2296,7 @@ will be deleted."
                      (if (not ov) (format "%s" from)
                        (format "%s (%s)"
                                (make-text-button (package-version-join ov) nil
-                                                 'face 'link
+                                                 'font-lock-face 'link
                                                  'follow-link t
                                                  'action
                                                  (lambda (_button)
@@ -2365,7 +2371,7 @@ will be deleted."
                                 :background "light grey"
                                 :foreground "black")
                        'link)))
-    (apply 'insert-text-button button-text 'face button-face 'follow-link t
+    (apply 'insert-text-button button-text 'font-lock-face button-face 
'follow-link t
            props)))
 
 
@@ -2386,6 +2392,7 @@ will be deleted."
     (define-key map "~" 'package-menu-mark-obsolete-for-deletion)
     (define-key map "x" 'package-menu-execute)
     (define-key map "h" 'package-menu-quick-help)
+    (define-key map "H" #'package-menu-hide-package)
     (define-key map "?" 'package-menu-describe-package)
     (define-key map "(" #'package-menu-toggle-hiding)
     (define-key map [menu-bar package-menu] (cons "Package" menu-map))
@@ -2870,7 +2877,8 @@ If optional arg BUTTON is non-nil, describe its 
associated package."
 (defvar package--quick-help-keys
   '(("install," "delete," "unmark," ("execute" . 1))
     ("next," "previous")
-    ("refresh-contents," "g-redisplay," "filter," "(-toggle-obsolete" "help")))
+    ("Hide-package," "(-toggle-hidden")
+    ("refresh-contents," "g-redisplay," "filter," "help")))
 
 (defun package--prettify-quick-help-key (desc)
   "Prettify DESC to be displayed as a help menu."
@@ -2879,9 +2887,8 @@ If optional arg BUTTON is non-nil, describe its 
associated package."
           (mapconcat #'package--prettify-quick-help-key desc "   ")
         (let ((place (cdr desc))
               (out (car desc)))
-          ;; (setq out (propertize out 'face 'paradox-comment-face))
           (add-text-properties place (1+ place)
-                               '(face (bold font-lock-function-name-face))
+                               '(face (bold font-lock-warning-face))
                                out)
           out))
     (package--prettify-quick-help-key (cons desc 0))))
diff --git a/test/automated/package-test.el b/test/automated/package-test.el
index 5ab2747..524613d 100644
--- a/test/automated/package-test.el
+++ b/test/automated/package-test.el
@@ -381,8 +381,9 @@ Must called from within a `tar-mode' buffer."
    (describe-package '5x5)
    (goto-char (point-min))
    (should (search-forward "5x5 is a built-in package." nil t))
-   (should (search-forward "Status: Built-in." nil t))
-   (should (search-forward "Summary: simple little puzzle game" nil t))
+   ;; Don't assume the descriptions are in any particular order.
+   (save-excursion (should (search-forward "Status: Built-in." nil t)))
+   (save-excursion (should (search-forward "Summary: simple little puzzle 
game" nil t)))
    (should (search-forward "The aim of 5x5" nil t)))
 
   ;; Installed
@@ -394,14 +395,11 @@ Must called from within a `tar-mode' buffer."
      (describe-package 'simple-single)
      (goto-char (point-min))
      (should (search-forward "simple-single is an installed package." nil t))
-     (should (re-search-forward
-              "Status: Installed in ['`‘]~/simple-single-1.3/['’] (unsigned)."
-              nil t))
-     (should (search-forward "Version: 1.3" nil t))
-     (should (search-forward "Summary: A single-file package with no 
dependencies"
-                             nil t))
-     (should (search-forward "Homepage: http://doodles.au"; nil t))
-     (should (re-search-forward "Keywords: \\[?frobnicate\\]?" nil t))
+     (save-excursion (should (re-search-forward "Status: Installed in 
['`‘]simple-single-1.3/['’] (unsigned)." nil t)))
+     (save-excursion (should (search-forward "Version: 1.3" nil t)))
+     (save-excursion (should (search-forward "Summary: A single-file package 
with no dependencies" nil t)))
+     (save-excursion (should (search-forward "Homepage: http://doodles.au"; nil 
t)))
+     (save-excursion (should (re-search-forward "Keywords: \\[?frobnicate\\]?" 
nil t)))
      ;; No description, though. Because at this point we don't know
      ;; what archive the package originated from, and we don't have
      ;; its readme file saved.