mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-11-24 07:20:37 +00:00
Merge Finder and package-menu functionality.
* lisp/finder.el: Require `package'. (finder-known-keywords): Tweak descriptions. Retire `oop' keyword. (finder-package-info): Var deleted. (finder-keywords-hash, finder--builtins-alist): New vars. (finder-compile-keywords): Compute package--builtins and finder-keywords-hash instead of finder-keywords-hash, respecting the "Package" header. (finder-unknown-keywords, finder-list-matches): Use finder-keywords-hash and package--list-packages. (finder-mode): Don't set font-lock-defaults. (finder-exit): We don't use "*Finder-package*" and "*Finder Category*" buffers anymore. * lisp/info.el (Info-finder-find-node): Search package-alist instead of finder-package-info. * lisp/emacs-lisp/package.el (package--builtins-base): Var deleted. (package--builtins): Set default value to nil. (package-initialize): Load precomputed value of package--builtins from finder-inf.el. (package-alist, package-compute-transaction) (package-download-transaction): Improve docstring. (package-read-all-archive-contents): Do not change package--builtins here. (list-packages): Make package-list-packages an alias for this. Sort by status by default. (package--list-packages): Add optional PACKAGES arg. (describe-package-1): Use font-lock-face property. For built-in packages, insert file commentary. (package--generate-package-list): Rename from package-list-packages-internal; all callers changed. Add optional PACKAGES arg. Add alphabetical sort fallbacks. (package-menu--version-predicate, package-menu--status-predicate) (package-menu--description-predicate) (package-menu--name-predicate): New functions.
This commit is contained in:
Chong Yidong
parent
aad4679e7d
commit
96ae4c8fa7
@ -1,3 +1,41 @@
|
||||
2010-08-29 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* finder.el: Require `package'.
|
||||
(finder-known-keywords): Tweak descriptions. Retire `oop' keyword.
|
||||
(finder-package-info): Var deleted.
|
||||
(finder-keywords-hash, finder--builtins-alist): New vars.
|
||||
(finder-compile-keywords): Compute package--builtins and
|
||||
finder-keywords-hash instead of finder-keywords-hash, respecting
|
||||
the "Package" header.
|
||||
(finder-unknown-keywords, finder-list-matches): Use
|
||||
finder-keywords-hash and package--list-packages.
|
||||
(finder-mode): Don't set font-lock-defaults.
|
||||
(finder-exit): We don't use "*Finder-package*" and "*Finder
|
||||
Category*" buffers anymore.
|
||||
|
||||
* emacs-lisp/package.el (package--builtins-base): Var deleted.
|
||||
(package--builtins): Set default value to nil.
|
||||
(package-initialize): Load precomputed value of package--builtins
|
||||
from finder-inf.el.
|
||||
(package-alist, package-compute-transaction)
|
||||
(package-download-transaction): Improve docstring.
|
||||
(package-read-all-archive-contents): Do not change
|
||||
package--builtins here.
|
||||
(list-packages): Make package-list-packages an alias for this.
|
||||
Sort by status by default.
|
||||
(package--list-packages): Add optional PACKAGES arg.
|
||||
(describe-package-1): Use font-lock-face property. For built-in
|
||||
packages, insert file commentary.
|
||||
(package--generate-package-list): Rename from
|
||||
package-list-packages-internal; all callers changed. Add optional
|
||||
PACKAGES arg. Add alphabetical sort fallbacks.
|
||||
(package-menu--version-predicate, package-menu--status-predicate)
|
||||
(package-menu--description-predicate)
|
||||
(package-menu--name-predicate): New functions.
|
||||
|
||||
* info.el (Info-finder-find-node): Search package-alist instead of
|
||||
finder-package-info.
|
||||
|
||||
2010-08-29 Chong Yidong <cyd@stupidchicken.com>
|
||||
|
||||
* subr.el (version-regexp-alist): Don't use "a" and "b" for
|
||||
|
||||
@ -273,46 +273,35 @@ contrast, `package-user-dir' contains packages for personal use."
|
||||
:group 'package
|
||||
:version "24.1")
|
||||
|
||||
(defconst package--builtins-base
|
||||
;; We use package-version split here to make sure to pick up the
|
||||
;; minor version.
|
||||
`((emacs . [,(version-to-list emacs-version) nil
|
||||
"GNU Emacs"])
|
||||
(package . [,(version-to-list package-el-version)
|
||||
nil "Simple package system for GNU Emacs"]))
|
||||
"Packages which are always built-in.")
|
||||
;; The value is precomputed in finder-inf.el, but don't load that
|
||||
;; until it's needed (i.e. when `package-intialize' is called).
|
||||
(defvar package--builtins nil
|
||||
"Alist of built-in packages.
|
||||
Each element has the form (PKG . DESC), where PKG is a package
|
||||
name (a symbol) and DESC is a vector that describes the package.
|
||||
|
||||
(defvar package--builtins
|
||||
(delq nil
|
||||
(append
|
||||
package--builtins-base
|
||||
(if (>= emacs-major-version 22)
|
||||
;; FIXME: emacs 22 includes tramp, rcirc, maybe
|
||||
;; other things...
|
||||
'((erc . [(5 2) nil "Internet Relay Chat client"])
|
||||
;; The external URL is version 1.15, so make sure the
|
||||
;; built-in one looks newer.
|
||||
(url . [(1 16) nil "URL handling libary"])))
|
||||
(if (>= emacs-major-version 23)
|
||||
'(;; Strangely, nxml-version is missing in Emacs 23.
|
||||
;; We pick the merge date as the version.
|
||||
(nxml . [(20071123) nil "Major mode for XML documents"])
|
||||
(bubbles . [(0 5) nil "A puzzle game"])))))
|
||||
"Alist of all built-in packages.
|
||||
Maps the package name to a vector [VERSION REQS DOCSTRING].")
|
||||
The vector DESC has the form [VERSION REQS DOCSTRING].
|
||||
VERSION is a version list.
|
||||
REQS is a list of packages (symbols) required by the package.
|
||||
DOCSTRING is a brief description of the package.")
|
||||
(put 'package--builtins 'risky-local-variable t)
|
||||
|
||||
(defvar package-alist package--builtins
|
||||
(defvar package-alist nil
|
||||
"Alist of all packages available for activation.
|
||||
This maps the package name to a vector [VERSION REQS DOCSTRING].
|
||||
Each element has the form (PKG . DESC), where PKG is a package
|
||||
name (a symbol) and DESC is a vector that describes the package.
|
||||
|
||||
The value is generated by `package-load-descriptor', usually
|
||||
called via `package-initialize'. For user customizations of
|
||||
which packages to load/activate, see `package-load-list'.")
|
||||
The vector DESC has the form [VERSION REQS DOCSTRING].
|
||||
VERSION is a version list.
|
||||
REQS is a list of packages (symbols) required by the package.
|
||||
DOCSTRING is a brief description of the package.
|
||||
|
||||
This variable is set automatically by `package-load-descriptor',
|
||||
called via `package-initialize'. To change which packages are
|
||||
loaded and/or activated, customize `package-load-list'.")
|
||||
(put 'package-archive-contents 'risky-local-variable t)
|
||||
|
||||
(defvar package-activated-list
|
||||
(mapcar #'car package-alist)
|
||||
(defvar package-activated-list nil
|
||||
"List of the names of currently activated packages.")
|
||||
(put 'package-activated-list 'risky-local-variable t)
|
||||
|
||||
@ -673,7 +662,19 @@ It will move point to somewhere in the headers."
|
||||
(version-list-<= min-version
|
||||
(package-desc-vers (cdr pkg-desc))))))
|
||||
|
||||
(defun package-compute-transaction (result requirements)
|
||||
(defun package-compute-transaction (package-list requirements)
|
||||
"Return a list of packages to be installed, including PACKAGE-LIST.
|
||||
PACKAGE-LIST should be a list of package names (symbols).
|
||||
|
||||
REQUIREMENTS should be a list of additional requirements; each
|
||||
element in this list should have the form (PACKAGE VERSION),
|
||||
where PACKAGE is a package name and VERSION is the required
|
||||
version of that package (as a list).
|
||||
|
||||
This function recursively computes the requirements of the
|
||||
packages in REQUIREMENTS, and returns a list of all the packages
|
||||
that must be installed. Packages that are already installed are
|
||||
not included in this list."
|
||||
(dolist (elt requirements)
|
||||
(let* ((next-pkg (car elt))
|
||||
(next-version (cadr elt)))
|
||||
@ -704,13 +705,13 @@ but version %s required"
|
||||
(symbol-name next-pkg) (package-version-join next-version)
|
||||
(package-version-join (package-desc-vers (cdr pkg-desc)))))
|
||||
;; Only add to the transaction if we don't already have it.
|
||||
(unless (memq next-pkg result)
|
||||
(setq result (cons next-pkg result)))
|
||||
(setq result
|
||||
(package-compute-transaction result
|
||||
(unless (memq next-pkg package-list)
|
||||
(setq package-list (cons next-pkg package-list)))
|
||||
(setq package-list
|
||||
(package-compute-transaction package-list
|
||||
(package-desc-reqs
|
||||
(cdr pkg-desc))))))))
|
||||
result)
|
||||
package-list)
|
||||
|
||||
(defun package-read-from-string (str)
|
||||
"Read a Lisp expression from STR.
|
||||
@ -744,22 +745,10 @@ Will throw an error if the archive version is too new."
|
||||
(cdr contents))))))
|
||||
|
||||
(defun package-read-all-archive-contents ()
|
||||
"Re-read `archive-contents' and `builtin-packages', if they exist.
|
||||
Set `package-archive-contents' and `package--builtins' if successful.
|
||||
Throw an error if the archive version is too new."
|
||||
"Re-read `archive-contents', if it exists.
|
||||
If successful, set `package-archive-contents'."
|
||||
(dolist (archive package-archives)
|
||||
(package-read-archive-contents (car archive)))
|
||||
(let ((builtins (package--read-archive-file "builtin-packages")))
|
||||
(if builtins
|
||||
;; Version 1 of 'builtin-packages' is a list where the car is
|
||||
;; a split emacs version and the cdr is an alist suitable for
|
||||
;; package--builtins.
|
||||
(let ((our-version (version-to-list emacs-version))
|
||||
(result package--builtins-base))
|
||||
(setq package--builtins
|
||||
(dolist (elt builtins result)
|
||||
(if (version-list-<= (car elt) our-version)
|
||||
(setq result (append (cdr elt) result)))))))))
|
||||
(package-read-archive-contents (car archive))))
|
||||
|
||||
(defun package-read-archive-contents (archive)
|
||||
"Re-read `archive-contents' and `builtin-packages' for ARCHIVE.
|
||||
@ -787,9 +776,13 @@ Also, add the originating archive to the end of the package vector."
|
||||
(version-list-< (aref existing-package 0) version))
|
||||
(add-to-list 'package-archive-contents entry))))
|
||||
|
||||
(defun package-download-transaction (transaction)
|
||||
"Download and install all the packages in the given transaction."
|
||||
(dolist (elt transaction)
|
||||
(defun package-download-transaction (package-list)
|
||||
"Download and install all the packages in PACKAGE-LIST.
|
||||
PACKAGE-LIST should be a list of package names (symbols).
|
||||
This function assumes that all package requirements in
|
||||
PACKAGE-LIST are satisfied, i.e. that PACKAGE-LIST is computed
|
||||
using `package-compute-transaction'."
|
||||
(dolist (elt package-list)
|
||||
(let* ((desc (cdr (assq elt package-archive-contents)))
|
||||
;; As an exception, if package is "held" in
|
||||
;; `package-load-list', download the held version.
|
||||
@ -1028,6 +1021,9 @@ download."
|
||||
"Load Emacs Lisp packages, and activate them.
|
||||
The variable `package-load-list' controls which packages to load."
|
||||
(interactive)
|
||||
(require 'finder-inf nil t)
|
||||
(setq package-alist package--builtins)
|
||||
(setq package-activated-list (mapcar #'car package-alist))
|
||||
(setq package-obsolete-alist nil)
|
||||
(package-load-all-descriptors)
|
||||
(package-read-all-archive-contents)
|
||||
@ -1066,6 +1062,7 @@ The variable `package-load-list' controls which packages to load."
|
||||
(describe-package-1 package)))))
|
||||
|
||||
(defun describe-package-1 (package)
|
||||
(require 'lisp-mnt)
|
||||
(let ((package-name (symbol-name package))
|
||||
(built-in (assq package package--builtins))
|
||||
desc pkg-dir reqs version installable)
|
||||
@ -1088,9 +1085,10 @@ The variable `package-load-list' controls which packages to load."
|
||||
installable t)
|
||||
(insert "an uninstalled package.\n\n"))
|
||||
|
||||
(insert " " (propertize "Status" 'face 'bold) ": ")
|
||||
(insert " " (propertize "Status" 'font-lock-face 'bold) ": ")
|
||||
(cond (pkg-dir
|
||||
(insert (propertize "Installed" 'face 'font-lock-comment-face))
|
||||
(insert (propertize "Installed"
|
||||
'font-lock-face 'font-lock-comment-face))
|
||||
(insert " in `")
|
||||
;; Todo: Add button for uninstalling.
|
||||
(help-insert-xref-button (file-name-as-directory pkg-dir)
|
||||
@ -1112,14 +1110,17 @@ The variable `package-load-list' controls which packages to load."
|
||||
'package-symbol package
|
||||
'action 'package-install-button-action)))
|
||||
(built-in
|
||||
(insert (propertize "Built-in" 'face 'font-lock-builtin-face) "."))
|
||||
(insert (propertize "Built-in"
|
||||
'font-lock-face 'font-lock-builtin-face) "."))
|
||||
(t (insert "Deleted.")))
|
||||
(insert "\n")
|
||||
(when version
|
||||
(insert " " (propertize "Version" 'face 'bold) ": " version "\n"))
|
||||
(and version
|
||||
(> (length version) 0)
|
||||
(insert " "
|
||||
(propertize "Version" 'font-lock-face 'bold) ": " version "\n"))
|
||||
(setq reqs (package-desc-reqs desc))
|
||||
(when reqs
|
||||
(insert " " (propertize "Requires" 'face 'bold) ": ")
|
||||
(insert " " (propertize "Requires" 'font-lock-face 'bold) ": ")
|
||||
(let ((first t)
|
||||
name vers text)
|
||||
(dolist (req reqs)
|
||||
@ -1134,38 +1135,46 @@ The variable `package-load-list' controls which packages to load."
|
||||
(t (insert ", ")))
|
||||
(help-insert-xref-button text 'help-package name))
|
||||
(insert "\n")))
|
||||
(insert " " (propertize "Summary" 'face 'bold)
|
||||
(insert " " (propertize "Summary" 'font-lock-face 'bold)
|
||||
": " (package-desc-doc desc) "\n\n")
|
||||
|
||||
;; Insert the package commentary.
|
||||
;; FIXME: We should try to be smarter about when to download.
|
||||
(let ((readme (expand-file-name (concat package-name "-readme.txt")
|
||||
package-user-dir)))
|
||||
;; Try downloading the commentary. If that fails, try an
|
||||
;; existing readme file in `package-user-dir'.
|
||||
(cond ((let ((buffer
|
||||
(condition-case nil
|
||||
(url-retrieve-synchronously
|
||||
(concat (package-archive-url package)
|
||||
package-name "-readme.txt"))
|
||||
(error nil)))
|
||||
response)
|
||||
(when buffer
|
||||
(with-current-buffer buffer
|
||||
(setq response (url-http-parse-response))
|
||||
(if (or (< response 200) (>= response 300))
|
||||
(setq response nil)
|
||||
(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)))))))
|
||||
(if (assq package package--builtins)
|
||||
;; For built-in packages, insert the commentary.
|
||||
(let ((fn (locate-file (concat package-name ".el") load-path
|
||||
load-file-rep-suffixes))
|
||||
(opoint (point)))
|
||||
(insert (or (lm-commentary fn) ""))
|
||||
(save-excursion
|
||||
(goto-char opoint)
|
||||
(when (re-search-forward "^;;; Commentary:\n" nil t)
|
||||
(replace-match ""))
|
||||
(while (re-search-forward "^\\(;+ ?\\)" nil t)
|
||||
(replace-match ""))))
|
||||
(let ((readme (expand-file-name (concat package-name "-readme.txt")
|
||||
package-user-dir)))
|
||||
;; For elpa packages, try downloading the commentary. If that
|
||||
;; fails, try an existing readme file in `package-user-dir'.
|
||||
(cond ((let ((buffer (ignore-errors
|
||||
(url-retrieve-synchronously
|
||||
(concat (package-archive-url package)
|
||||
package-name "-readme.txt"))))
|
||||
response)
|
||||
(when buffer
|
||||
(with-current-buffer buffer
|
||||
(setq response (url-http-parse-response))
|
||||
(if (or (< response 200) (>= response 300))
|
||||
(setq response nil)
|
||||
(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)))
|
||||
@ -1195,6 +1204,8 @@ The variable `package-load-list' controls which packages to load."
|
||||
(define-key map "x" 'package-menu-execute)
|
||||
(define-key map "h" 'package-menu-quick-help)
|
||||
(define-key map "?" 'package-menu-describe-package)
|
||||
(define-key map [follow-link] 'mouse-face)
|
||||
(define-key map [mouse-2] 'mouse-select-window)
|
||||
(define-key map [menu-bar package-menu] (cons "Package" menu-map))
|
||||
(define-key menu-map [mq]
|
||||
'(menu-item "Quit" quit-window
|
||||
@ -1246,6 +1257,7 @@ The variable `package-load-list' controls which packages to load."
|
||||
(defvar package-menu-sort-button-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(define-key map [header-line mouse-1] 'package-menu-sort-by-column)
|
||||
(define-key map [header-line mouse-2] 'package-menu-sort-by-column)
|
||||
(define-key map [follow-link] 'mouse-face)
|
||||
map)
|
||||
"Local keymap for package menu sort buttons.")
|
||||
@ -1276,12 +1288,12 @@ package menu. This lets you see what new packages are
|
||||
available for download."
|
||||
(interactive)
|
||||
(package-refresh-contents)
|
||||
(package-list-packages-internal))
|
||||
(package--generate-package-list))
|
||||
|
||||
(defun package-menu-revert ()
|
||||
"Update the list of packages."
|
||||
(interactive)
|
||||
(package-list-packages-internal))
|
||||
(package--generate-package-list))
|
||||
|
||||
(defun package-menu-describe-package ()
|
||||
"Describe the package in the current line."
|
||||
@ -1429,7 +1441,7 @@ Emacs."
|
||||
;; This decides how we should sort; nil means by package name.
|
||||
(defvar package-menu-sort-key nil)
|
||||
|
||||
(defun package-list-packages-internal ()
|
||||
(defun package--generate-package-list (&optional packages)
|
||||
(package-initialize) ; FIXME: do this here?
|
||||
(with-current-buffer (get-buffer-create "*Packages*")
|
||||
(setq buffer-read-only nil)
|
||||
@ -1439,34 +1451,35 @@ Emacs."
|
||||
builtin)
|
||||
;; List installed packages
|
||||
(dolist (elt package-alist)
|
||||
;; Ignore the Emacs package.
|
||||
(setq name (car elt)
|
||||
desc (cdr elt)
|
||||
hold (assq name package-load-list))
|
||||
(unless (memq name '(emacs package))
|
||||
(setq name (car elt))
|
||||
(when (and (not (eq name 'emacs)) ; Hide the `emacs' package.
|
||||
(or (null packages)
|
||||
(memq name packages)))
|
||||
(setq desc (cdr elt)
|
||||
hold (cadr (assq name package-load-list))
|
||||
builtin (cdr (assq name package--builtins)))
|
||||
(setq info-list
|
||||
(package-list-maybe-add
|
||||
name (package-desc-vers desc)
|
||||
;; FIXME: it turns out to be tricky to see if this
|
||||
;; package is presently activated.
|
||||
(cond ((stringp (cadr hold))
|
||||
"held")
|
||||
((and (setq builtin (assq name package--builtins))
|
||||
(cond ((stringp hold) "held")
|
||||
((and builtin
|
||||
(version-list-=
|
||||
(package-desc-vers (cdr builtin))
|
||||
(package-desc-vers builtin)
|
||||
(package-desc-vers desc)))
|
||||
"built-in")
|
||||
(t "installed"))
|
||||
(package-desc-doc desc)
|
||||
info-list))))
|
||||
;; List available packages
|
||||
|
||||
;; List available and disabled packages
|
||||
(dolist (elt package-archive-contents)
|
||||
(setq name (car elt)
|
||||
desc (cdr elt)
|
||||
hold (assq name package-load-list))
|
||||
(unless (and hold (stringp (cadr hold))
|
||||
(package-installed-p
|
||||
name (version-to-list (cadr hold))))
|
||||
(when (or (null packages)
|
||||
(memq name packages))
|
||||
(setq info-list
|
||||
(package-list-maybe-add name
|
||||
(package-desc-vers desc)
|
||||
@ -1488,47 +1501,80 @@ Emacs."
|
||||
info-list)))
|
||||
(cdr elt)))
|
||||
package-obsolete-alist)
|
||||
(let ((selector (cond
|
||||
((string= package-menu-sort-key "Version")
|
||||
;; FIXME this doesn't work.
|
||||
#'(lambda (e) (cdr (car e))))
|
||||
((string= package-menu-sort-key "Status")
|
||||
#'(lambda (e) (car (cdr e))))
|
||||
((string= package-menu-sort-key "Description")
|
||||
#'(lambda (e) (car (cdr (cdr e)))))
|
||||
(t ; "Package" is default.
|
||||
#'(lambda (e) (symbol-name (car (car e))))))))
|
||||
(setq info-list
|
||||
(sort info-list
|
||||
(lambda (left right)
|
||||
(let ((vleft (funcall selector left))
|
||||
(vright (funcall selector right)))
|
||||
(string< vleft vright))))))
|
||||
(mapc (lambda (elt)
|
||||
(package-print-package (car (car elt))
|
||||
(cdr (car elt))
|
||||
(car (cdr elt))
|
||||
(car (cdr (cdr elt)))))
|
||||
info-list))
|
||||
|
||||
(setq info-list
|
||||
(sort info-list
|
||||
(cond ((string= package-menu-sort-key "Version")
|
||||
'package-menu--version-predicate)
|
||||
((string= package-menu-sort-key "Status")
|
||||
'package-menu--status-predicate)
|
||||
((string= package-menu-sort-key "Description")
|
||||
'package-menu--description-predicate)
|
||||
(t ; Sort by package name by default
|
||||
'package-menu--name-predicate))))
|
||||
|
||||
(dolist (elt info-list)
|
||||
(package-print-package (car (car elt))
|
||||
(cdr (car elt))
|
||||
(car (cdr elt))
|
||||
(car (cdr (cdr elt))))))
|
||||
(goto-char (point-min))
|
||||
(set-buffer-modified-p nil)
|
||||
(current-buffer)))
|
||||
|
||||
(defun package-menu--version-predicate (left right)
|
||||
(let ((vleft (cdr (car left)))
|
||||
(vright (cdr (car right))))
|
||||
(if (version-list-= vleft right)
|
||||
(package-menu--name-predicate left right)
|
||||
(version-list-< left right))))
|
||||
|
||||
(defun package-menu--status-predicate (left right)
|
||||
(let ((sleft (cadr left))
|
||||
(sright (cadr right)))
|
||||
(cond ((string= sleft sright)
|
||||
(package-menu--name-predicate left right))
|
||||
((string= sleft "available") t)
|
||||
((string= sright "available") nil)
|
||||
((string= sleft "installed") t)
|
||||
((string= sright "installed") nil)
|
||||
((string= sleft "held") t)
|
||||
((string= sright "held") nil)
|
||||
((string= sleft "built-in") t)
|
||||
((string= sright "built-in") nil)
|
||||
((string= sleft "obsolete") t)
|
||||
((string= sright "obsolete") nil)
|
||||
(t (string< sleft sright)))))
|
||||
|
||||
(defun package-menu--description-predicate (left right)
|
||||
(let ((sleft (car (cddr left)))
|
||||
(sright (car (cddr right))))
|
||||
(if (string= sleft sright)
|
||||
(package-menu--name-predicate left right)
|
||||
(string< sleft sright))))
|
||||
|
||||
(defun package-menu--name-predicate (left right)
|
||||
(string< (symbol-name (caar left))
|
||||
(symbol-name (caar right))))
|
||||
|
||||
(defun package-menu-sort-by-column (&optional e)
|
||||
"Sort the package menu by the last column clicked on."
|
||||
(interactive (list last-input-event))
|
||||
(interactive "e")
|
||||
(if e (mouse-select-window e))
|
||||
(let* ((pos (event-start e))
|
||||
(obj (posn-object pos))
|
||||
(col (if obj
|
||||
(get-text-property (cdr obj) 'column-name (car obj))
|
||||
(get-text-property (posn-point pos) 'column-name))))
|
||||
(setq package-menu-sort-key col))
|
||||
(package-list-packages-internal))
|
||||
(obj (posn-object pos))
|
||||
(col (if obj
|
||||
(get-text-property (cdr obj) 'column-name (car obj))
|
||||
(get-text-property (posn-point pos) 'column-name)))
|
||||
(inhibit-read-only t))
|
||||
(setq package-menu-sort-key col)
|
||||
(package--generate-package-list)))
|
||||
|
||||
(defun package--list-packages ()
|
||||
"Display a list of packages.
|
||||
Helper function that does all the work for the user-facing functions."
|
||||
(with-current-buffer (package-list-packages-internal)
|
||||
(defun package--list-packages (&optional packages)
|
||||
"Display the properties of PACKAGES.
|
||||
PACKAGES should be a list of package names (symbols).
|
||||
If PACKAGES is nil, display all packages in `package-alist'."
|
||||
(with-current-buffer (package--generate-package-list packages)
|
||||
(package-menu-mode)
|
||||
;; Set up the header line.
|
||||
(setq header-line-format
|
||||
@ -1560,22 +1606,22 @@ Helper function that does all the work for the user-facing functions."
|
||||
""))
|
||||
|
||||
;; It's okay to use pop-to-buffer here. The package menu buffer
|
||||
;; has keybindings, and the user just typed 'M-x
|
||||
;; package-list-packages', suggesting that they might want to use
|
||||
;; them.
|
||||
;; has keybindings, and the user just typed `M-x list-packages',
|
||||
;; suggesting that they might want to use them.
|
||||
(pop-to-buffer (current-buffer))))
|
||||
|
||||
;;;###autoload
|
||||
(defun package-list-packages ()
|
||||
(defun list-packages ()
|
||||
"Display a list of packages.
|
||||
Fetches the updated list of packages before displaying.
|
||||
The list is displayed in a buffer named `*Packages*'."
|
||||
(interactive)
|
||||
(package-refresh-contents)
|
||||
(setq package-menu-sort-key "Status")
|
||||
(package--list-packages))
|
||||
|
||||
;;;###autoload
|
||||
(defalias 'list-packages 'package-list-packages)
|
||||
(defalias 'package-list-packages 'list-packages)
|
||||
|
||||
(defun package-list-packages-no-fetch ()
|
||||
"Display a list of packages.
|
||||
|
||||
292
lisp/finder.el
292
lisp/finder.el
@ -30,6 +30,7 @@
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'package)
|
||||
(require 'lisp-mnt)
|
||||
(require 'find-func) ;for find-library(-suffixes)
|
||||
;; Use `load' rather than `require' so that it doesn't get loaded
|
||||
@ -39,46 +40,42 @@
|
||||
;; These are supposed to correspond to top-level customization groups,
|
||||
;; says rms.
|
||||
(defvar finder-known-keywords
|
||||
'(
|
||||
(abbrev . "abbreviation handling, typing shortcuts, macros")
|
||||
;; Too specific:
|
||||
(bib . "code related to the `bib' bibliography processor")
|
||||
(c . "support for the C language and related languages")
|
||||
(calendar . "calendar and time management support")
|
||||
(comm . "communications, networking, remote access to files")
|
||||
'((abbrev . "abbreviation handling, typing shortcuts, and macros")
|
||||
(bib . "bibliography processors")
|
||||
(c . "C and related programming languages")
|
||||
(calendar . "calendar and time management tools")
|
||||
(comm . "communications, networking, and remote file access")
|
||||
(convenience . "convenience features for faster editing")
|
||||
(data . "support for editing files of data")
|
||||
(docs . "support for Emacs documentation")
|
||||
(data . "editing data (non-text) files")
|
||||
(docs . "Emacs documentation facilities")
|
||||
(emulations . "emulations of other editors")
|
||||
(extensions . "Emacs Lisp language extensions")
|
||||
(faces . "support for multiple fonts")
|
||||
(files . "support for editing and manipulating files")
|
||||
(frames . "support for Emacs frames and window systems")
|
||||
(faces . "fonts and colors for text")
|
||||
(files . "file editing and manipulation")
|
||||
(frames . "Emacs frames and window systems")
|
||||
(games . "games, jokes and amusements")
|
||||
(hardware . "support for interfacing with exotic hardware")
|
||||
(help . "support for on-line help systems")
|
||||
(hypermedia . "support for links between text or other media types")
|
||||
(i18n . "internationalization and alternate character-set support")
|
||||
(hardware . "interfacing with system hardware")
|
||||
(help . "on-line help systems")
|
||||
(hypermedia . "links between text or other media types")
|
||||
(i18n . "internationalization and character-set support")
|
||||
(internal . "code for Emacs internals, build process, defaults")
|
||||
(languages . "specialized modes for editing programming languages")
|
||||
(lisp . "Lisp support, including Emacs Lisp")
|
||||
(local . "code local to your site")
|
||||
(maint . "maintenance aids for the Emacs development group")
|
||||
(mail . "modes for electronic-mail handling")
|
||||
(matching . "various sorts of searching and matching")
|
||||
(maint . "Emacs development tools and aids")
|
||||
(mail . "email reading and posting")
|
||||
(matching . "searching, matching, and sorting")
|
||||
(mouse . "mouse support")
|
||||
(multimedia . "images and sound support")
|
||||
(news . "support for netnews reading and posting")
|
||||
(oop . "support for object-oriented programming")
|
||||
(outlines . "support for hierarchical outlining")
|
||||
(processes . "process, subshell, compilation, and job control support")
|
||||
(terminals . "support for terminal types")
|
||||
(tex . "supporting code for the TeX formatter")
|
||||
(multimedia . "images and sound")
|
||||
(news . "USENET news reading and posting")
|
||||
(outlines . "hierarchical outlining and note taking")
|
||||
(processes . "processes, subshells, and compilation")
|
||||
(terminals . "text terminals (ttys)")
|
||||
(tex . "the TeX document formatter")
|
||||
(tools . "programming tools")
|
||||
(unix . "front-ends/assistants for, or emulators of, UNIX-like features")
|
||||
(unix . "UNIX feature interfaces and emulators")
|
||||
(vc . "version control")
|
||||
(wp . "word processing")
|
||||
))
|
||||
(wp . "word processing")))
|
||||
|
||||
(defvar finder-mode-map
|
||||
(let ((map (make-sparse-keymap))
|
||||
@ -125,8 +122,9 @@
|
||||
|
||||
;;; Code for regenerating the keyword list.
|
||||
|
||||
(defvar finder-package-info nil
|
||||
"Assoc list mapping file names to description & keyword lists.")
|
||||
(defvar finder-keywords-hash nil
|
||||
"Hash table mapping keywords to lists of package names.
|
||||
Keywords and package names both should be symbols.")
|
||||
|
||||
(defvar generated-finder-keywords-file "finder-inf.el"
|
||||
"The function `finder-compile-keywords' writes keywords into this file.")
|
||||
@ -142,10 +140,91 @@ cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
|
||||
|
||||
(autoload 'autoload-rubric "autoload")
|
||||
|
||||
(defvar finder--builtins-alist
|
||||
'(("calc" . calc)
|
||||
("ede" . ede)
|
||||
("erc" . erc)
|
||||
("eshell" . eshell)
|
||||
("gnus" . gnus)
|
||||
("international" . emacs)
|
||||
("language" . emacs)
|
||||
("mh-e" . mh-e)
|
||||
("semantic" . semantic)
|
||||
("analyze" . semantic)
|
||||
("bovine" . semantic)
|
||||
("decorate" . semantic)
|
||||
("symref" . semantic)
|
||||
("wisent" . semantic)
|
||||
("nxml" . nxml)
|
||||
("org" . org)
|
||||
("srecode" . srecode)
|
||||
("term" . emacs)
|
||||
("url" . url))
|
||||
"Alist of built-in package directories.
|
||||
Each element should have the form (DIR . PACKAGE), where DIR is a
|
||||
directory name and PACKAGE is the name of a package (a symbol).
|
||||
When generating `package--builtins', Emacs assumes any file in
|
||||
DIR is part of the package PACKAGE.")
|
||||
|
||||
(defun finder-compile-keywords (&rest dirs)
|
||||
"Regenerate the keywords association list into `generated-finder-keywords-file'.
|
||||
Optional arguments DIRS are a list of Emacs Lisp directories to compile from;
|
||||
no arguments compiles from `load-path'."
|
||||
"Regenerate list of built-in Emacs packages.
|
||||
This recomputes `package--builtins' and `finder-keywords-hash',
|
||||
and prints them into the file `generated-finder-keywords-file'.
|
||||
|
||||
Optional DIRS is a list of Emacs Lisp directories to compile
|
||||
from; the default is `load-path'."
|
||||
;; Allow compressed files also.
|
||||
(setq package--builtins nil)
|
||||
(setq finder-keywords-hash (make-hash-table :test 'eq))
|
||||
(let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
|
||||
package-override files base-name processed
|
||||
summary keywords package version entry desc)
|
||||
(dolist (d (or dirs load-path))
|
||||
(when (file-exists-p (directory-file-name d))
|
||||
(message "Directory %s" d)
|
||||
(setq package-override
|
||||
(intern-soft
|
||||
(cdr-safe
|
||||
(assoc (file-name-nondirectory (directory-file-name d))
|
||||
finder--builtins-alist))))
|
||||
(setq files (directory-files d nil el-file-regexp))
|
||||
(dolist (f files)
|
||||
(unless (or (string-match finder-no-scan-regexp f)
|
||||
(null (setq base-name
|
||||
(and (string-match el-file-regexp f)
|
||||
(intern (match-string 1 f)))))
|
||||
(memq base-name processed))
|
||||
(push base-name processed)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (expand-file-name f d))
|
||||
(setq summary (lm-synopsis)
|
||||
keywords (mapcar 'intern (lm-keywords-list))
|
||||
package (or package-override
|
||||
(intern-soft (lm-header "package"))
|
||||
base-name)
|
||||
version (lm-header "version")))
|
||||
(when summary
|
||||
(setq version (ignore-errors (version-to-list version)))
|
||||
(setq entry (assq package package--builtins))
|
||||
(cond ((null entry)
|
||||
(push (cons package (vector version nil summary))
|
||||
package--builtins))
|
||||
((eq base-name package)
|
||||
(setq desc (cdr entry))
|
||||
(aset desc 0 version)
|
||||
(aset desc 2 summary)))
|
||||
(dolist (kw keywords)
|
||||
(puthash kw
|
||||
(cons package
|
||||
(delq package
|
||||
(gethash kw finder-keywords-hash)))
|
||||
finder-keywords-hash))))))))
|
||||
|
||||
(setq package--builtins
|
||||
(sort package--builtins
|
||||
(lambda (a b) (string< (symbol-name (car a))
|
||||
(symbol-name (car b))))))
|
||||
|
||||
(save-excursion
|
||||
(find-file generated-finder-keywords-file)
|
||||
(setq buffer-undo-list t)
|
||||
@ -153,40 +232,23 @@ no arguments compiles from `load-path'."
|
||||
(insert (autoload-rubric generated-finder-keywords-file
|
||||
"keyword-to-package mapping" t))
|
||||
(search-backward " ")
|
||||
(insert "(setq finder-package-info '(\n")
|
||||
(let (processed summary keywords)
|
||||
(mapc
|
||||
(lambda (d)
|
||||
(when (file-exists-p (directory-file-name d))
|
||||
(message "Directory %s" d)
|
||||
(mapc
|
||||
(lambda (f)
|
||||
;; FIXME should this not be using (expand-file-name f d)?
|
||||
(unless (or (member f processed)
|
||||
(string-match finder-no-scan-regexp f))
|
||||
(setq processed (cons f processed))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (expand-file-name f d))
|
||||
(setq summary (lm-synopsis)
|
||||
keywords (lm-keywords-list)))
|
||||
(insert
|
||||
(format " (\"%s\"\n "
|
||||
(if (string-match "\\.\\(gz\\|Z\\)$" f)
|
||||
(file-name-sans-extension f)
|
||||
f)))
|
||||
(prin1 summary (current-buffer))
|
||||
(insert "\n ")
|
||||
(prin1 (mapcar 'intern keywords) (current-buffer))
|
||||
(insert ")\n")))
|
||||
(directory-files d nil
|
||||
;; Allow compressed files also. FIXME:
|
||||
;; generalize this, especially for
|
||||
;; MS-DOG-type filenames.
|
||||
"^[^=].*\\.el\\(\\.\\(gz\\|Z\\)\\)?$"
|
||||
))))
|
||||
(or dirs load-path)))
|
||||
(insert " ))\n")
|
||||
(eval-buffer) ; so we get the new keyword list immediately
|
||||
(insert "(setq package--builtins '(\n")
|
||||
(dolist (package package--builtins)
|
||||
(insert " (")
|
||||
(prin1 (car package) (current-buffer))
|
||||
(insert " .\n [")
|
||||
(let ((desc (cdr package)))
|
||||
(prin1 (aref desc 0) (current-buffer))
|
||||
(insert " ")
|
||||
(prin1 (aref desc 1) (current-buffer))
|
||||
(insert " ")
|
||||
(prin1 (aref desc 2) (current-buffer)))
|
||||
(insert "])\n"))
|
||||
(insert " ))\n\n")
|
||||
;; Insert hash table.
|
||||
(insert "(setq finder-keywords-hash\n ")
|
||||
(prin1 finder-keywords-hash (current-buffer))
|
||||
(insert ")\n")
|
||||
(basic-save-buffer)))
|
||||
|
||||
(defun finder-compile-keywords-make-dist ()
|
||||
@ -226,26 +288,14 @@ no arguments compiles from `load-path'."
|
||||
|
||||
(defun finder-unknown-keywords ()
|
||||
"Return an alist of unknown keywords and number of their occurences.
|
||||
Unknown are keywords that are present in `finder-package-info'
|
||||
but absent in `finder-known-keywords'."
|
||||
(let ((unknown-keywords-hash (make-hash-table)))
|
||||
;; Prepare a hash where key is a keyword
|
||||
;; and value is the number of keyword occurences.
|
||||
(mapc (lambda (package)
|
||||
(mapc (lambda (keyword)
|
||||
(unless (assq keyword finder-known-keywords)
|
||||
(puthash keyword
|
||||
(1+ (gethash keyword unknown-keywords-hash 0))
|
||||
unknown-keywords-hash)))
|
||||
(nth 2 package)))
|
||||
finder-package-info)
|
||||
;; Make an alist from the hash and sort by the keyword name.
|
||||
(sort (let (unknown-keywords-list)
|
||||
(maphash (lambda (key value)
|
||||
(push (cons key value) unknown-keywords-list))
|
||||
unknown-keywords-hash)
|
||||
unknown-keywords-list)
|
||||
(lambda (a b) (string< (car a) (car b))))))
|
||||
Unknown keywords are those present in `finder-keywords-hash' but
|
||||
not `finder-known-keywords'."
|
||||
(let (alist)
|
||||
(maphash (lambda (kw packages)
|
||||
(unless (assq kw finder-known-keywords)
|
||||
(push (cons kw (length packages)) alist)))
|
||||
finder-keywords-hash)
|
||||
(sort alist (lambda (a b) (string< (car a) (car b))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun finder-list-keywords ()
|
||||
@ -255,46 +305,28 @@ but absent in `finder-known-keywords'."
|
||||
(pop-to-buffer "*Finder*")
|
||||
(pop-to-buffer (get-buffer-create "*Finder*"))
|
||||
(finder-mode)
|
||||
(setq buffer-read-only nil
|
||||
buffer-undo-list t)
|
||||
(erase-buffer)
|
||||
(mapc
|
||||
(lambda (assoc)
|
||||
(let ((keyword (car assoc)))
|
||||
(insert (symbol-name keyword))
|
||||
(finder-insert-at-column 14 (concat (cdr assoc) "\n"))
|
||||
(finder-mouse-face-on-line)))
|
||||
finder-known-keywords)
|
||||
(goto-char (point-min))
|
||||
(setq finder-headmark (point)
|
||||
buffer-read-only t)
|
||||
(set-buffer-modified-p nil)
|
||||
(balance-windows)
|
||||
(finder-summary)))
|
||||
(let ((inhibit-read-only t))
|
||||
(erase-buffer)
|
||||
(dolist (assoc finder-known-keywords)
|
||||
(let ((keyword (car assoc)))
|
||||
(insert (propertize (symbol-name keyword)
|
||||
'font-lock-face 'font-lock-constant-face))
|
||||
(finder-insert-at-column 14 (concat (cdr assoc) "\n"))
|
||||
(finder-mouse-face-on-line)))
|
||||
(goto-char (point-min))
|
||||
(setq finder-headmark (point)
|
||||
buffer-read-only t)
|
||||
(set-buffer-modified-p nil)
|
||||
(balance-windows)
|
||||
(finder-summary))))
|
||||
|
||||
(defun finder-list-matches (key)
|
||||
(pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*")))
|
||||
(finder-mode)
|
||||
(setq buffer-read-only nil
|
||||
buffer-undo-list t)
|
||||
(erase-buffer)
|
||||
(let ((id (intern key)))
|
||||
(insert
|
||||
"The following packages match the keyword `" key "':\n\n")
|
||||
(setq finder-headmark (point))
|
||||
(mapc
|
||||
(lambda (x)
|
||||
(when (memq id (cadr (cdr x)))
|
||||
(insert (car x))
|
||||
(finder-insert-at-column 16 (concat (cadr x) "\n"))
|
||||
(finder-mouse-face-on-line)))
|
||||
finder-package-info)
|
||||
(goto-char (point-min))
|
||||
(forward-line)
|
||||
(setq buffer-read-only t)
|
||||
(set-buffer-modified-p nil)
|
||||
(shrink-window-if-larger-than-buffer)
|
||||
(finder-summary)))
|
||||
(let* ((id (intern key))
|
||||
(packages (gethash id finder-keywords-hash)))
|
||||
(unless packages
|
||||
(error "No packages matching key `%s'" key))
|
||||
(setq package-menu-sort-key nil)
|
||||
(package--list-packages packages)))
|
||||
|
||||
(define-button-type 'finder-xref 'action #'finder-goto-xref)
|
||||
|
||||
@ -381,8 +413,8 @@ FILE should be in a form suitable for passing to `locate-library'."
|
||||
\\[finder-select] more help for the item on the current line
|
||||
\\[finder-exit] exit Finder mode and kill the Finder buffer."
|
||||
:syntax-table finder-mode-syntax-table
|
||||
(setq font-lock-defaults '(finder-font-lock-keywords nil nil
|
||||
(("+-*/.<>=!?$%_&~^:@" . "w")) nil))
|
||||
(setq buffer-read-only t
|
||||
buffer-undo-list t)
|
||||
(set (make-local-variable 'finder-headmark) nil))
|
||||
|
||||
(defun finder-summary ()
|
||||
@ -399,8 +431,8 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
|
||||
Delete the window and kill all Finder-related buffers."
|
||||
(interactive)
|
||||
(ignore-errors (delete-window))
|
||||
(dolist (buff '("*Finder*" "*Finder-package*" "*Finder Category*"))
|
||||
(and (get-buffer buff) (kill-buffer buff))))
|
||||
(let ((buf "*Finder*"))
|
||||
(and (get-buffer buf) (kill-buffer buf))))
|
||||
|
||||
|
||||
(provide 'finder)
|
||||
|
||||
@ -2641,7 +2641,7 @@ will be inserted before the group at point."
|
||||
;;;;;; ibuffer-backward-filter-group ibuffer-forward-filter-group
|
||||
;;;;;; ibuffer-toggle-filter-group ibuffer-mouse-toggle-filter-group
|
||||
;;;;;; ibuffer-interactive-filter-by-mode ibuffer-mouse-filter-by-mode
|
||||
;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "e1272bfdc7c3b6e926b2a68155217303")
|
||||
;;;;;; ibuffer-auto-mode) "ibuf-ext" "ibuf-ext.el" "fa9822b5ef905f06d8a03dc9ce3a2894")
|
||||
;;; Generated autoloads from ibuf-ext.el
|
||||
|
||||
(autoload 'ibuffer-auto-mode "ibuf-ext" "\
|
||||
|
||||
83
lisp/info.el
83
lisp/info.el
@ -3372,7 +3372,6 @@ Build a menu of the possible matches."
|
||||
filename)
|
||||
|
||||
(defvar finder-known-keywords)
|
||||
(defvar finder-package-info)
|
||||
(declare-function find-library-name "find-func" (library))
|
||||
(declare-function finder-unknown-keywords "finder" ())
|
||||
(declare-function lm-commentary "lisp-mnt" (&optional file))
|
||||
@ -3388,15 +3387,14 @@ Build a menu of the possible matches."
|
||||
(insert "Finder Keywords\n")
|
||||
(insert "***************\n\n")
|
||||
(insert "* Menu:\n\n")
|
||||
(mapc
|
||||
(lambda (assoc)
|
||||
(let ((keyword (car assoc)))
|
||||
(insert (format "* %-14s %s.\n"
|
||||
(concat (symbol-name keyword) "::")
|
||||
(cdr assoc)))))
|
||||
(append '((all . "All package info")
|
||||
(unknown . "unknown keywords"))
|
||||
finder-known-keywords)))
|
||||
(dolist (assoc (append '((all . "All package info")
|
||||
(unknown . "unknown keywords"))
|
||||
finder-known-keywords))
|
||||
(let ((keyword (car assoc)))
|
||||
(insert (format "* %s %s.\n"
|
||||
(concat (symbol-name keyword) ": "
|
||||
"kw:" (symbol-name keyword) ".")
|
||||
(cdr assoc))))))
|
||||
((equal nodename "unknown")
|
||||
;; Display unknown keywords
|
||||
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
|
||||
@ -3416,17 +3414,36 @@ Build a menu of the possible matches."
|
||||
Info-finder-file nodename))
|
||||
(insert "Finder Package Info\n")
|
||||
(insert "*******************\n\n")
|
||||
(mapc (lambda (package)
|
||||
(insert (format "%s - %s\n"
|
||||
(format "*Note %s::" (nth 0 package))
|
||||
(nth 1 package)))
|
||||
(insert "Keywords: "
|
||||
(mapconcat (lambda (keyword)
|
||||
(format "*Note %s::" (symbol-name keyword)))
|
||||
(nth 2 package) ", ")
|
||||
"\n\n"))
|
||||
finder-package-info))
|
||||
((string-match-p "\\.el\\'" nodename)
|
||||
(dolist (package package-alist)
|
||||
(insert (format "%s - %s\n"
|
||||
(format "*Note %s::" (nth 0 package))
|
||||
(nth 1 package)))))
|
||||
((string-match "\\`kw:" nodename)
|
||||
(setq nodename (substring nodename (match-end 0)))
|
||||
;; Display packages that match the keyword
|
||||
;; or the list of keywords separated by comma.
|
||||
(insert (format "\n\^_\nFile: %s, Node: kw:%s, Up: Top\n\n"
|
||||
Info-finder-file nodename))
|
||||
(insert "Finder Packages\n")
|
||||
(insert "***************\n\n")
|
||||
(insert
|
||||
"The following packages match the keyword `" nodename "':\n\n")
|
||||
(insert "* Menu:\n\n")
|
||||
(let ((keywords
|
||||
(mapcar 'intern (if (string-match-p "," nodename)
|
||||
(split-string nodename ",[ \t\n]*" t)
|
||||
(list nodename))))
|
||||
hits desc)
|
||||
(dolist (kw keywords)
|
||||
(push (copy-tree (gethash kw finder-keywords-hash)) hits))
|
||||
(setq hits (delete-dups (apply 'append hits)))
|
||||
(dolist (package hits)
|
||||
(setq desc (cdr-safe (assq package package-alist)))
|
||||
(when (vectorp desc)
|
||||
(insert (format "* %-16s %s.\n"
|
||||
(concat (symbol-name package) "::")
|
||||
(aref desc 2)))))))
|
||||
(t
|
||||
;; Display commentary section
|
||||
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
|
||||
Info-finder-file nodename))
|
||||
@ -3447,29 +3464,7 @@ Build a menu of the possible matches."
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward "^;+ ?" nil t)
|
||||
(replace-match "" nil nil))
|
||||
(buffer-string))))))
|
||||
(t
|
||||
;; Display packages that match the keyword
|
||||
;; or the list of keywords separated by comma.
|
||||
(insert (format "\n\^_\nFile: %s, Node: %s, Up: Top\n\n"
|
||||
Info-finder-file nodename))
|
||||
(insert "Finder Packages\n")
|
||||
(insert "***************\n\n")
|
||||
(insert
|
||||
"The following packages match the keyword `" nodename "':\n\n")
|
||||
(insert "* Menu:\n\n")
|
||||
(let ((keywords
|
||||
(mapcar 'intern (if (string-match-p "," nodename)
|
||||
(split-string nodename ",[ \t\n]*" t)
|
||||
(list nodename)))))
|
||||
(mapc
|
||||
(lambda (package)
|
||||
(unless (memq nil (mapcar (lambda (k) (memq k (nth 2 package)))
|
||||
keywords))
|
||||
(insert (format "* %-16s %s.\n"
|
||||
(concat (nth 0 package) "::")
|
||||
(nth 1 package)))))
|
||||
finder-package-info)))))
|
||||
(buffer-string))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun info-finder (&optional keywords)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user