From 0aec2aaccd8b745fa7214f3edd453c04a04bfba4 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 6 Aug 2015 11:24:16 +0100 Subject: [PATCH] * 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. --- lisp/emacs-lisp/package.el | 83 ++++++++++++++++++++++---------------- 1 file changed, 49 insertions(+), 34 deletions(-) diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 492f8cc3e1a..967720881f6 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))) -- 2.39.5