commit 0aec2aaccd8b745fa7214f3edd453c04a04bfba4 (HEAD, refs/remotes/origin/master) Author: Artur Malabarba Date: Thu Aug 6 11:24:16 2015 +0100 * lisp/emacs-lisp/package.el: Simplify describe-package-1 (package-help-section-name-face): New face. (package--print-help-section): New function. (describe-package-1): Refactor section printing. (package-make-button): Use face instead of font-lock-face, which doesn't work on buttons. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 492f8cc..9677208 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2143,6 +2143,22 @@ will be deleted." (with-current-buffer standard-output (describe-package-1 package))))) +(defface package-help-section-name-face + '((t :inherit (bold font-lock-function-name-face))) + "Face used on section names in package description buffers." + :version "25.1") + +(defun package--print-help-section (name &rest strings) + "Print \"NAME: \", right aligned to the 13th column. +If more STRINGS are provided, insert them followed by a newline. +Otherwise no newline is inserted." + (declare (indent 1)) + (insert (make-string (max 0 (- 11 (string-width name))) ?\s) + (propertize (concat name ": ") 'font-lock-face 'package-help-section-name-face)) + (when strings + (apply #'insert strings) + (insert "\n"))) + (declare-function lm-commentary "lisp-mnt" (&optional file)) (defun describe-package-1 (pkg) @@ -2178,16 +2194,16 @@ will be deleted." (princ status) (princ " package.\n\n") - (insert " " (propertize "Status" 'font-lock-face 'bold) ": ") + (package--print-help-section "Status") (cond (built-in (insert (propertize (capitalize status) - 'font-lock-face 'font-lock-builtin-face) + 'font-lock-face 'package-status-builtin-face) ".")) (pkg-dir (insert (propertize (if (member status '("unsigned" "dependency")) "Installed" (capitalize status)) - 'font-lock-face 'font-lock-builtin-face)) + 'font-lock-face 'package-status-builtin-face)) (insert (substitute-command-keys " in ‘")) (let ((dir (abbreviate-file-name (file-name-as-directory @@ -2200,7 +2216,7 @@ will be deleted." (insert (substitute-command-keys "’,\n shadowing a ") (propertize "built-in package" - 'font-lock-face 'font-lock-builtin-face)) + 'font-lock-face 'package-status-builtin-face)) (insert (substitute-command-keys "’"))) (if signed (insert ".") @@ -2229,18 +2245,18 @@ will be deleted." (t (insert (capitalize status) "."))) (insert "\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")) + (package--print-help-section "Archive" + (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") + (package--print-help-section "Version" + (package-version-join version))) + (when desc + (package--print-help-section "Summary" + (package-desc-summary desc))) (setq reqs (if desc (package-desc-reqs desc))) (when reqs - (insert " " (propertize "Requires" 'font-lock-face 'bold) ": ") + (package--print-help-section "Requires") (let ((first t)) (dolist (req reqs) (let* ((name (car req)) @@ -2259,7 +2275,7 @@ will be deleted." (insert reason))) (insert "\n"))) (when required-by - (insert (propertize "Required by" 'font-lock-face 'bold) ": ") + (package--print-help-section "Required by") (let ((first t)) (dolist (pkg required-by) (let ((text (package-desc-full-name pkg))) @@ -2272,11 +2288,11 @@ will be deleted." (package-desc-name pkg)))) (insert "\n"))) (when homepage - (insert " " (propertize "Homepage" 'font-lock-face 'bold) ": ") + (package--print-help-section "Homepage") (help-insert-xref-button homepage 'help-url homepage) (insert "\n")) (when keywords - (insert " " (propertize "Keywords" 'font-lock-face 'bold) ": ") + (package--print-help-section "Keywords") (dolist (k keywords) (package-make-button k @@ -2290,24 +2306,23 @@ will be deleted." (if bi (list (package--from-builtin bi)))))) (other-pkgs (delete desc all-pkgs))) (when other-pkgs - (insert " " (propertize "Other versions" 'font-lock-face 'bold) ": " - (mapconcat - (lambda (opkg) - (let* ((ov (package-desc-version opkg)) - (dir (package-desc-dir opkg)) - (from (or (package-desc-archive opkg) - (if (stringp dir) "installed" dir)))) - (if (not ov) (format "%s" from) - (format "%s (%s)" - (make-text-button (package-version-join ov) nil - 'font-lock-face 'link - 'follow-link t - 'action - (lambda (_button) - (describe-package opkg))) - from)))) - other-pkgs ", ") - ".\n"))) + (package--print-help-section "Other versions" + (mapconcat (lambda (opkg) + (let* ((ov (package-desc-version opkg)) + (dir (package-desc-dir opkg)) + (from (or (package-desc-archive opkg) + (if (stringp dir) "installed" dir)))) + (if (not ov) (format "%s" from) + (format "%s (%s)" + (make-text-button (package-version-join ov) nil + 'font-lock-face 'link + 'follow-link t + 'action + (lambda (_button) + (describe-package opkg))) + from)))) + other-pkgs ", ") + "."))) (insert "\n") @@ -2375,7 +2390,7 @@ will be deleted." :background "light grey" :foreground "black") 'link))) - (apply 'insert-text-button button-text 'font-lock-face button-face 'follow-link t + (apply 'insert-text-button button-text 'face button-face 'follow-link t props))) commit 1be349c628b9fedd6db96dcd5e3d9d1abb60e4d0 Author: Artur Malabarba Date: Thu Aug 6 09:37:27 2015 +0100 * lisp/emacs-lisp/package.el: Define custom faces (package-name-face, package-description-face) (package-status-built-in-face, package-status-external-face) (package-status-available-face, package-status-new-face) (package-status-held-face, package-status-disabled-face) (package-status-installed-face, package-status-dependency-face) (package-status-unsigned-face, package-status-incompat-face) (package-status-avail-obso-face): New faces. (package-menu--print-info-simple): Use them. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 60977a7..492f8cc 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -2741,27 +2741,97 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." (make-obsolete 'package-menu--print-info 'package-menu--print-info-simple "25.1") + +;;; Package menu faces +(defface package-name-face + '((t :inherit link)) + "Face used on package names in the package menu." + :version "25.1") + +(defface package-description-face + '((t :inherit default)) + "Face used on package description summaries in the package menu." + :version "25.1") + +(defface package-status-built-in-face + '((t :inherit font-lock-builtin-face)) + "Face used on the status and version of built-in packages." + :version "25.1") + +(defface package-status-external-face + '((t :inherit package-status-builtin-face)) + "Face used on the status and version of external packages." + :version "25.1") + +(defface package-status-available-face + '((t :inherit default)) + "Face used on the status and version of available packages." + :version "25.1") + +(defface package-status-new-face + '((t :inherit (bold package-status-available-face))) + "Face used on the status and version of new packages." + :version "25.1") + +(defface package-status-held-face + '((t :inherit font-lock-constant-face)) + "Face used on the status and version of held packages." + :version "25.1") + +(defface package-status-disabled-face + '((t :inherit font-lock-warning-face)) + "Face used on the status and version of disabled packages." + :version "25.1") + +(defface package-status-installed-face + '((t :inherit font-lock-comment-face)) + "Face used on the status and version of installed packages." + :version "25.1") + +(defface package-status-dependency-face + '((t :inherit package-status-installed-face)) + "Face used on the status and version of dependency packages." + :version "25.1") + +(defface package-status-unsigned-face + '((t :inherit font-lock-warning-face)) + "Face used on the status and version of unsigned packages." + :version "25.1") + +(defface package-status-incompat-face + '((t :inherit font-lock-comment-face)) + "Face used on the status and version of incompat packages." + :version "25.1") + +(defface package-status-avail-obso-face + '((t :inherit package-status-incompat-face)) + "Face used on the status and version of avail-obso packages." + :version "25.1") + + +;;; Package menu printing (defun package-menu--print-info-simple (pkg) "Return a package entry suitable for `tabulated-list-entries'. PKG is a package-desc object. Return (PKG-DESC [NAME VERSION STATUS DOC])." (let* ((status (package-desc-status pkg)) (face (pcase status - (`"built-in" 'font-lock-builtin-face) - (`"external" 'font-lock-builtin-face) - (`"available" 'default) - (`"avail-obso" 'font-lock-comment-face) - (`"new" 'bold) - (`"held" 'font-lock-constant-face) - (`"disabled" 'font-lock-warning-face) - (`"installed" 'font-lock-comment-face) - (`"dependency" 'font-lock-comment-face) - (`"unsigned" 'font-lock-warning-face) - (`"incompat" 'font-lock-comment-face) + (`"built-in" 'package-status-built-in-face) + (`"external" 'package-status-external-face) + (`"available" 'package-status-available-face) + (`"avail-obso" 'package-status-avail-obso-face) + (`"new" 'package-status-new-face) + (`"held" 'package-status-held-face) + (`"disabled" 'package-status-disabled-face) + (`"installed" 'package-status-installed-face) + (`"dependency" 'package-status-dependency-face) + (`"unsigned" 'package-status-unsigned-face) + (`"incompat" 'package-status-incompat-face) (_ 'font-lock-warning-face)))) ; obsolete. (list pkg `[(,(symbol-name (package-desc-name pkg)) - face link + face package-name-face + font-lock-face package-name-face follow-link t package-desc ,pkg action package-menu-describe-package) @@ -2772,7 +2842,8 @@ Return (PKG-DESC [NAME VERSION STATUS DOC])." ,@(if (cdr package-archives) (list (propertize (or (package-desc-archive pkg) "") 'font-lock-face face))) - ,(package-desc-summary pkg)]))) + ,(propertize (package-desc-summary pkg) + 'font-lock-face 'package-description-face)]))) (defvar package-menu--old-archive-contents nil "`package-archive-contents' before the latest refresh.")