From 8adb4c33da6fb4c3dfeb664152b0076e6d62fef8 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Sun, 20 Jun 2010 00:55:14 -0400 Subject: [PATCH] Tweaks to package list UI. * help-mode.el (help-package): New button type. * emacs-lisp/package.el (package-print-package): Add link to package description via describe-package. (describe-package-1): List package requirements. Add button to perform installation. (package-menu-describe-package): New command. --- lisp/ChangeLog | 10 ++++++ lisp/emacs-lisp/package.el | 74 ++++++++++++++++++++++++++++++++------ lisp/help-mode.el | 5 +++ 3 files changed, 78 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f4d0d1ac2b1..a1776062cda 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2010-06-20 Chong Yidong + + * emacs-lisp/package.el (package-print-package): Add link to + package description via describe-package. + (describe-package-1): List package requirements. Add button to + perform installation. + (package-menu-describe-package): New command. + + * help-mode.el (help-package): New button type. + 2010-06-19 Chong Yidong * emacs-lisp/package.el: Move package-list-packages binding to diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 2a93535718c..c6035442313 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1069,7 +1069,7 @@ The variable `package-load-list' controls which packages to load." (defun describe-package-1 (package) (let ((desc (cdr (assq package package-alist))) - version) + reqs version installable) (prin1 package) (princ " is ") (cond @@ -1091,14 +1091,51 @@ The variable `package-load-list' controls which packages to load." (setq version nil))))) (t ;; An uninstalled package. - (setq desc (cdr (assq package package-archive-contents))) - (setq version (package-version-join (package-desc-vers desc))) - (insert "a package that is not installed.\n\n"))) + (setq desc (cdr (assq package package-archive-contents)) + version (package-version-join (package-desc-vers desc)) + installable t) + (insert "an installable package.\n\n"))) (if version (insert " Version: " version "\n")) - (insert " Description: " (package-desc-doc desc) "\n"))) -;; To do: add buttons for installing, uninstalling, etc. - + (setq reqs (package-desc-reqs desc)) + (when reqs + (insert " Requires: ") + (let ((first t) + name vers text) + (dolist (req reqs) + (setq name (car req) + vers (cadr req) + text (format "%s-%s" (symbol-name name) + (package-version-join vers))) + (cond (first (setq first nil)) + ((>= (+ 2 (current-column) (length text)) + (window-width)) + (insert ",\n ")) + (t (insert ", "))) + (help-insert-xref-button text 'help-package name)) + (insert "\n"))) + (insert " Description: " (package-desc-doc desc) "\n") + ;; Todo: button for uninstalling a package. + (when installable + (let ((button-text (if (display-graphic-p) + "Install" + "[Install]")) + (button-face (if (display-graphic-p) + '(:box (:line-width 2 :color "dark grey") + :background "light grey" + :foreground "black") + 'link))) + (insert "\n") + (insert-text-button button-text + 'face button-face + 'follow-link t + 'package-symbol package + 'action (lambda (button) + (package-install + (button-get button 'package-symbol)) + (revert-buffer nil t) + (goto-char (point-min)))) + (insert "\n"))))) ;;;; Package menu mode. @@ -1107,6 +1144,7 @@ The variable `package-load-list' controls which packages to load." (let ((map (make-keymap)) (menu-map (make-sparse-keymap "Package"))) (suppress-keymap map) + (define-key map "\C-m" 'package-menu-describe-package) (define-key map "q" 'quit-window) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) @@ -1208,6 +1246,14 @@ available for download." (interactive) (package-list-packages-internal)) +(defun package-menu-describe-package () + "Describe the package in the current line." + (interactive) + (let ((name (package-menu-get-package))) + (if name + (describe-package (intern name)) + (message "No package on this line")))) + (defun package-menu-mark-internal (what) (unless (eobp) (let ((buffer-read-only nil)) @@ -1286,7 +1332,7 @@ For larger packages, shows the README file." (save-excursion (beginning-of-line) (if (looking-at ". \\([^ \t]*\\)") - (match-string 1)))) + (match-string-no-properties 1)))) ;; Return the version of the package on the current line. (defun package-menu-get-version () @@ -1342,14 +1388,20 @@ Emacs." (t ; obsolete, but also the default. 'font-lock-warning-face)))) (insert (propertize " " 'font-lock-face face)) - (insert (propertize (symbol-name package) 'font-lock-face face)) + (insert-text-button (symbol-name package) + 'face 'link + 'follow-link t + 'package-symbol package + 'action (lambda (button) + (describe-package + (button-get button 'package-symbol)))) (indent-to 20 1) (insert (propertize (package-version-join version) 'font-lock-face face)) - (indent-to 30 1) + (indent-to 32 1) (insert (propertize key 'font-lock-face face)) ;; FIXME: this 'when' is bogus... (when desc - (indent-to 41 1) + (indent-to 43 1) (insert (propertize desc 'font-lock-face face))) (insert "\n"))) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index b04a289b4ae..7a7a1ddaf79 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -244,6 +244,11 @@ The format is (FUNCTION ARGS...).") (message "Unable to find location in file")))) 'help-echo (purecopy "mouse-2, RET: find face's definition")) +(define-button-type 'help-package + :supertype 'help-xref + 'help-function 'describe-package + 'help-echo (purecopy "mouse-2, RET: Describe package")) + (define-button-type 'help-package-def :supertype 'help-xref 'help-function (lambda (file) (dired file)) -- 2.39.2