Commit cb6c4991 authored by Chong Yidong's avatar Chong Yidong

Improvements to describe-package buffer.

* lisp/help.el (help-map): Bind `C-h P' to describe-package.

* lisp/menu-bar.el (menu-bar-describe-menu): Add describe-package.

* lisp/emacs-lisp/package.el (package-refresh-contents): Catch errors
when downloading archives.
(describe-package-1): Add package commentary.
(package-install-button-action): New function.
(package-menu-mode-map): Bind ? to package-menu-describe-package.
(package-menu-view-commentary): Function removed.
(package-list-packages-internal): Hide the `package' package too.
parent fe50eb41
...@@ -176,8 +176,12 @@ for `list-colors-display'. ...@@ -176,8 +176,12 @@ for `list-colors-display'.
** An Emacs Lisp package manager is now included. ** An Emacs Lisp package manager is now included.
This is a convenient way to download and install additional packages, This is a convenient way to download and install additional packages,
from elpa.gnu.org. `M-x package-list-packages' shows a list of from elpa.gnu.org.
packages, which can be selected for installation.
*** `M-x list-packages' shows a list of packages, which can be
selected for installation.
*** New command `describe-package', bound to `C-h P'.
*** By default, all installed packages are loaded and activated *** By default, all installed packages are loaded and activated
automatically when Emacs starts up. To disable this, set automatically when Emacs starts up. To disable this, set
......
2010-08-26 Chong Yidong <cyd@stupidchicken.com>
* help.el (help-map): Bind `C-h P' to describe-package.
* menu-bar.el (menu-bar-describe-menu): Add describe-package.
* emacs-lisp/package.el (package-refresh-contents): Catch errors
when downloading archives.
(describe-package-1): Add package commentary.
(package-install-button-action): New function.
(package-menu-mode-map): Bind ? to package-menu-describe-package.
(package-menu-view-commentary): Function removed.
(package-list-packages-internal): Hide the `package' package too.
2010-08-25 Kenichi Handa <handa@m17n.org> 2010-08-25 Kenichi Handa <handa@m17n.org>
* language/misc-lang.el ("Arabic"): New language environment. * language/misc-lang.el ("Arabic"): New language environment.
......
...@@ -216,6 +216,7 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")." ...@@ -216,6 +216,7 @@ If VERSION is nil, the package is not loaded (it is \"disabled\")."
(declare-function lm-header "lisp-mnt" (header)) (declare-function lm-header "lisp-mnt" (header))
(declare-function lm-commentary "lisp-mnt" (&optional file)) (declare-function lm-commentary "lisp-mnt" (&optional file))
(declare-function dired-delete-file "dired" (file &optional recursive trash)) (declare-function dired-delete-file "dired" (file &optional recursive trash))
(defvar url-http-end-of-headers)
(defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/")) (defcustom package-archives '(("gnu" . "http://elpa.gnu.org/packages/"))
"An alist of archives from which to fetch. "An alist of archives from which to fetch.
...@@ -1016,7 +1017,10 @@ download." ...@@ -1016,7 +1017,10 @@ download."
(unless (file-exists-p package-user-dir) (unless (file-exists-p package-user-dir)
(make-directory package-user-dir t)) (make-directory package-user-dir t))
(dolist (archive package-archives) (dolist (archive package-archives)
(package--download-one-archive archive "archive-contents")) (condition-case nil
(package--download-one-archive archive "archive-contents")
(error (message "Failed to download archive `%s'."
(car archive)))))
(package-read-all-archive-contents)) (package-read-all-archive-contents))
;;;###autoload ;;;###autoload
...@@ -1052,9 +1056,7 @@ The variable `package-load-list' controls which packages to load." ...@@ -1052,9 +1056,7 @@ The variable `package-load-list' controls which packages to load."
guess) guess)
"Describe package: ") "Describe package: ")
packages nil t nil nil guess)) packages nil t nil nil guess))
(list (if (equal val "") (list (if (equal val "") guess (intern val)))))
guess
(intern val)))))
(if (or (null package) (null (symbolp package))) (if (or (null package) (null (symbolp package)))
(message "You did not specify a package") (message "You did not specify a package")
(help-setup-xref (list #'describe-package package) (help-setup-xref (list #'describe-package package)
...@@ -1064,38 +1066,60 @@ The variable `package-load-list' controls which packages to load." ...@@ -1064,38 +1066,60 @@ The variable `package-load-list' controls which packages to load."
(describe-package-1 package))))) (describe-package-1 package)))))
(defun describe-package-1 (package) (defun describe-package-1 (package)
(let ((desc (cdr (assq package package-alist))) (let ((package-name (symbol-name package))
reqs version installable) (built-in (assq package package--builtins))
desc pkg-dir reqs version installable)
(prin1 package) (prin1 package)
(princ " is ") (princ " is ")
(cond (if (setq desc (cdr (assq package package-alist)))
(desc ;; This package is loaded (i.e. in `package-alist').
;; This package is loaded (i.e. in `package-alist'). (progn
(let (pkg-dir) (setq version (package-version-join (package-desc-vers desc)))
(setq version (package-version-join (package-desc-vers desc))) (cond (built-in
(if (assq package package--builtins) (princ "a built-in package.\n\n"))
(princ "a built-in package.\n\n") ((setq pkg-dir (package--dir package-name version))
(setq pkg-dir (package--dir (symbol-name package) version)) (insert "an installed package.\n\n"))
(if pkg-dir (t ;; This normally does not happen.
(progn (insert "a deleted package.\n\n")
(insert "a package installed in `") (setq version nil))))
(help-insert-xref-button (file-name-as-directory pkg-dir) ;; This package is not installed.
'help-package-def pkg-dir) (setq desc (cdr (assq package package-archive-contents))
(insert "'.\n\n"))
;; This normally does not happen.
(insert "a deleted package.\n\n")
(setq version nil)))))
(t
;; An uninstalled package.
(setq desc (cdr (assq package package-archive-contents))
version (package-version-join (package-desc-vers desc)) version (package-version-join (package-desc-vers desc))
installable t) installable t)
(insert "an installable package.\n\n"))) (insert "an uninstalled package.\n\n"))
(if version
(insert " Version: " version "\n")) (insert " " (propertize "Status" 'face 'bold) ": ")
(cond (pkg-dir
(insert (propertize "Installed" 'face 'font-lock-comment-face))
(insert " in `")
;; Todo: Add button for uninstalling.
(help-insert-xref-button (file-name-as-directory pkg-dir)
'help-package-def pkg-dir)
(insert "'."))
(installable
(insert "Available -- ")
(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-text-button button-text
'face button-face
'follow-link t
'package-symbol package
'action 'package-install-button-action)))
(built-in
(insert (propertize "Built-in" 'face 'font-lock-builtin-face) "."))
(t (insert "Deleted.")))
(insert "\n")
(when version
(insert " " (propertize "Version" 'face 'bold) ": " version "\n"))
(setq reqs (package-desc-reqs desc)) (setq reqs (package-desc-reqs desc))
(when reqs (when reqs
(insert " Requires: ") (insert " " (propertize "Requires" 'face 'bold) ": ")
(let ((first t) (let ((first t)
name vers text) name vers text)
(dolist (req reqs) (dolist (req reqs)
...@@ -1110,28 +1134,45 @@ The variable `package-load-list' controls which packages to load." ...@@ -1110,28 +1134,45 @@ The variable `package-load-list' controls which packages to load."
(t (insert ", "))) (t (insert ", ")))
(help-insert-xref-button text 'help-package name)) (help-insert-xref-button text 'help-package name))
(insert "\n"))) (insert "\n")))
(insert " Description: " (package-desc-doc desc) "\n") (insert " " (propertize "Summary" 'face 'bold)
;; Todo: button for uninstalling a package. ": " (package-desc-doc desc) "\n\n")
(when installable
(let ((button-text (if (display-graphic-p) ;; Insert the package commentary.
"Install" ;; FIXME: We should try to be smarter about when to download.
"[Install]")) (let ((readme (expand-file-name (concat package-name "-readme.txt")
(button-face (if (display-graphic-p) package-user-dir)))
'(:box (:line-width 2 :color "dark grey") ;; Try downloading the commentary. If that fails, try an
:background "light grey" ;; existing readme file in `package-user-dir'.
:foreground "black") (cond ((let ((buffer
'link))) (condition-case nil
(insert "\n") (url-retrieve-synchronously
(insert-text-button button-text (concat (package-archive-url package)
'face button-face package-name "-readme.txt"))
'follow-link t (error nil)))
'package-symbol package response)
'action (lambda (button) (when buffer
(package-install (with-current-buffer buffer
(button-get button 'package-symbol)) (setq response (url-http-parse-response))
(revert-buffer nil t) (if (or (< response 200) (>= response 300))
(goto-char (point-min)))) (setq response nil)
(insert "\n"))))) (setq buffer-file-name
(expand-file-name readme package-user-dir))
(delete-region (point-min) (1+ url-http-end-of-headers))
(save-buffer)))
(when response
(insert-buffer-substring buffer)
(kill-buffer buffer)
t))))
((file-readable-p readme)
(insert-file-contents readme)
(goto-char (point-max)))))))
(defun package-install-button-action (button)
(let ((package (button-get button 'package-symbol)))
(when (y-or-n-p (format "Install package `%s'? " package))
(package-install package)
(revert-buffer nil t)
(goto-char (point-min)))))
;;;; Package menu mode. ;;;; Package menu mode.
...@@ -1153,7 +1194,7 @@ The variable `package-load-list' controls which packages to load." ...@@ -1153,7 +1194,7 @@ The variable `package-load-list' controls which packages to load."
(define-key map "~" 'package-menu-mark-obsolete-for-deletion) (define-key map "~" 'package-menu-mark-obsolete-for-deletion)
(define-key map "x" 'package-menu-execute) (define-key map "x" 'package-menu-execute)
(define-key map "h" 'package-menu-quick-help) (define-key map "h" 'package-menu-quick-help)
(define-key map "?" 'package-menu-view-commentary) (define-key map "?" 'package-menu-describe-package)
(define-key map [menu-bar package-menu] (cons "Package" menu-map)) (define-key map [menu-bar package-menu] (cons "Package" menu-map))
(define-key menu-map [mq] (define-key menu-map [mq]
'(menu-item "Quit" quit-window '(menu-item "Quit" quit-window
...@@ -1297,32 +1338,8 @@ available for download." ...@@ -1297,32 +1338,8 @@ available for download."
(interactive) (interactive)
(message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp")) (message "n-ext, i-nstall, d-elete, u-nmark, x-ecute, r-efresh, h-elp"))
(defun package-menu-view-commentary () (define-obsolete-function-alias
"Display information about this package. 'package-menu-view-commentary 'package-menu-describe-package "24.1")
For single-file packages, shows the commentary section from the header.
For larger packages, shows the README file."
(interactive)
(let* ((pkg-name (package-menu-get-package))
(buffer (url-retrieve-synchronously
(concat (package-archive-url pkg-name)
pkg-name
"-readme.txt")))
start-point ok)
(with-current-buffer buffer
;; FIXME: it would be nice to work with any URL type.
(setq start-point url-http-end-of-headers)
(setq ok (eq (url-http-parse-response) 200)))
(let ((new-buffer (get-buffer-create "*Package Info*")))
(with-current-buffer new-buffer
(let ((buffer-read-only nil))
(erase-buffer)
(insert "Package information for " pkg-name "\n\n")
(if ok
(insert-buffer-substring buffer start-point)
(insert "This package lacks a README file or commentary.\n"))
(goto-char (point-min))
(view-mode)))
(display-buffer new-buffer t))))
;; Return the name of the package on the current line. ;; Return the name of the package on the current line.
(defun package-menu-get-package () (defun package-menu-get-package ()
...@@ -1426,7 +1443,7 @@ Emacs." ...@@ -1426,7 +1443,7 @@ Emacs."
(setq name (car elt) (setq name (car elt)
desc (cdr elt) desc (cdr elt)
hold (assq name package-load-list)) hold (assq name package-load-list))
(unless (eq name 'emacs) (unless (memq name '(emacs package))
(setq info-list (setq info-list
(package-list-maybe-add (package-list-maybe-add
name (package-desc-vers desc) name (package-desc-vers desc)
......
...@@ -103,6 +103,7 @@ ...@@ -103,6 +103,7 @@
(define-key map "m" 'describe-mode) (define-key map "m" 'describe-mode)
(define-key map "n" 'view-emacs-news) (define-key map "n" 'view-emacs-news)
(define-key map "p" 'finder-by-keyword) (define-key map "p" 'finder-by-keyword)
(define-key map "P" 'describe-package)
(define-key map "r" 'info-emacs-manual) (define-key map "r" 'info-emacs-manual)
(define-key map "s" 'describe-syntax) (define-key map "s" 'describe-syntax)
(define-key map "t" 'help-with-tutorial) (define-key map "t" 'help-with-tutorial)
......
...@@ -1485,6 +1485,9 @@ mail status in mode line")) ...@@ -1485,6 +1485,9 @@ mail status in mode line"))
(define-key menu-bar-describe-menu [describe-current-display-table] (define-key menu-bar-describe-menu [describe-current-display-table]
`(menu-item ,(purecopy "Describe Display Table") describe-current-display-table `(menu-item ,(purecopy "Describe Display Table") describe-current-display-table
:help ,(purecopy "Describe the current display table"))) :help ,(purecopy "Describe the current display table")))
(define-key menu-bar-describe-menu [describe-package]
`(menu-item ,(purecopy "Describe Package...") describe-package
:help ,(purecopy "Display documentation of a Lisp package")))
(define-key menu-bar-describe-menu [describe-face] (define-key menu-bar-describe-menu [describe-face]
`(menu-item ,(purecopy "Describe Face...") describe-face `(menu-item ,(purecopy "Describe Face...") describe-face
:help ,(purecopy "Display the properties of a face"))) :help ,(purecopy "Display the properties of a face")))
...@@ -1616,11 +1619,11 @@ key, a click, or a menu-item"))) ...@@ -1616,11 +1619,11 @@ key, a click, or a menu-item")))
(define-key menu-bar-help-menu [sep2] (define-key menu-bar-help-menu [sep2]
menu-bar-separator) menu-bar-separator)
(define-key menu-bar-help-menu [external-packages] (define-key menu-bar-help-menu [external-packages]
`(menu-item ,(purecopy "External Packages") menu-bar-help-extra-packages `(menu-item ,(purecopy "Finding Extra Packages") menu-bar-help-extra-packages
:help ,(purecopy "Lisp packages distributed separately for use in Emacs"))) :help ,(purecopy "Lisp packages distributed separately for use in Emacs")))
(define-key menu-bar-help-menu [find-emacs-packages] (define-key menu-bar-help-menu [find-emacs-packages]
`(menu-item ,(purecopy "Find Emacs Packages") finder-by-keyword `(menu-item ,(purecopy "Search Built-in Packages") finder-by-keyword
:help ,(purecopy "Find packages and features by keyword"))) :help ,(purecopy "Find built-in packages and features by keyword")))
(define-key menu-bar-help-menu [more-manuals] (define-key menu-bar-help-menu [more-manuals]
`(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu)) `(menu-item ,(purecopy "More Manuals") ,menu-bar-manuals-menu))
(define-key menu-bar-help-menu [emacs-manual] (define-key menu-bar-help-menu [emacs-manual]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment