Commit ca66737c authored by Artur Malabarba's avatar Artur Malabarba

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