[Emacs-diffs] /srv/bzr/emacs/trunk r100622: Tweaks to package list UI.

[Chong Yidong]

------------------------------------------------------------
revno: 100622
committer: Chong Yidong <address@hidden>
branch nick: trunk
timestamp: Sun 2010-06-20 00:55:14 -0400
message:
  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.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/package.el
  lisp/help-mode.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-06-19 22:36:51 +0000
+++ b/lisp/ChangeLog    2010-06-20 04:55:14 +0000
@@ -1,3 +1,13 @@
+2010-06-20  Chong Yidong  <address@hidden>
+
+       * 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  <address@hidden>
 
        * emacs-lisp/package.el: Move package-list-packages binding to

=== modified file 'lisp/emacs-lisp/package.el'
--- a/lisp/emacs-lisp/package.el        2010-06-19 22:36:51 +0000
+++ b/lisp/emacs-lisp/package.el        2010-06-20 04:55:14 +0000
@@ -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")))
 

=== modified file 'lisp/help-mode.el'
--- a/lisp/help-mode.el 2010-06-19 22:36:51 +0000
+++ b/lisp/help-mode.el 2010-06-20 04:55:14 +0000
@@ -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))