Mercurial > emacs
changeset 109027:858e3e43cfd5
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.
| author | Chong Yidong <cyd@stupidchicken.com> |
|---|---|
| date | Sun, 20 Jun 2010 00:55:14 -0400 |
| parents | c138aa96dae8 |
| children | 9f55c53fc33a a4002b21a37b |
| files | lisp/ChangeLog lisp/emacs-lisp/package.el lisp/help-mode.el |
| diffstat | 3 files changed, 78 insertions(+), 11 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Sat Jun 19 18:36:51 2010 -0400 +++ b/lisp/ChangeLog Sun Jun 20 00:55:14 2010 -0400 @@ -1,3 +1,13 @@ +2010-06-20 Chong Yidong <cyd@stupidchicken.com> + + * 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 <cyd@stupidchicken.com> * emacs-lisp/package.el: Move package-list-packages binding to
--- a/lisp/emacs-lisp/package.el Sat Jun 19 18:36:51 2010 -0400 +++ b/lisp/emacs-lisp/package.el Sun Jun 20 00:55:14 2010 -0400 @@ -1069,7 +1069,7 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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 @@ (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")))
--- a/lisp/help-mode.el Sat Jun 19 18:36:51 2010 -0400 +++ b/lisp/help-mode.el Sun Jun 20 00:55:14 2010 -0400 @@ -244,6 +244,11 @@ (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))