;;; finder.el --- topic & keyword-based code finder
-;; Copyright (C) 1992, 1997-1999, 2001-2011 Free Software Foundation, Inc.
+;; Copyright (C) 1992, 1997-1999, 2001-2014 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
(tools . "programming tools")
(unix . "UNIX feature interfaces and emulators")
(vc . "version control")
- (wp . "word processing")))
+ (wp . "word processing"))
+ "Association list of the standard \"Keywords:\" headers.
+Each element has the form (KEYWORD . DESCRIPTION).")
(defvar finder-mode-map
(let ((map (make-sparse-keymap))
(define-key menu-map [finder-select]
'(menu-item "Select" finder-select
:help "Select item on current line in a finder buffer"))
- map))
+ map)
+ "Keymap used in `finder-mode'.")
(defvar finder-mode-syntax-table
(let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
"Font-lock keywords for Finder mode.")
(defvar finder-headmark nil
- "Internal finder-mode variable, local in finder buffer.")
+ "Internal Finder mode variable, local in Finder buffer.")
;;; Code for regenerating the keyword list.
;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
;; ldefs-boot is not auto-generated, but has nothing useful.
(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
-cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
+cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
"Regexp matching file names not to scan for keywords.")
(autoload 'autoload-rubric "autoload")
+(defconst finder--builtins-descriptions
+ ;; I have no idea whether these are supposed to be capitalized
+ ;; and/or end in a full-stop. Existing file headers are inconsistent,
+ ;; but mainly seem to not do so.
+ '((emacs . "the extensible text editor")
+ (nxml . "a new XML mode"))
+ "Alist of built-in package descriptions.
+Entries have the form (PACKAGE-SYMBOL . DESCRIPTION).
+When generating `package--builtins', this overrides what the description
+would otherwise be.")
+
(defvar finder--builtins-alist
'(("calc" . calc)
("ede" . ede)
("decorate" . semantic)
("symref" . semantic)
("wisent" . semantic)
+ ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el
+ ;; is the main file for the package. Then we would not need an
+ ;; entry in finder--builtins-descriptions. But I do not know if
+ ;; it is safe to change this, in case it is already in use.
("nxml" . nxml)
("org" . org)
("srecode" . srecode)
(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
+ 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))
(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)
+ (intern (match-string 1 f))))))
+;; (memq base-name processed))
+;; There are multiple files in the tree with the same basename.
+;; So skipping files based on basename means you randomly (depending
+;; on which order the files are traversed in) miss some packages.
+;; http://debbugs.gnu.org/14010
+;; You might think this could lead to two files providing the same package,
+;; but it does not, because the duplicates are (at time of writing)
+;; all due to files in cedet, which end up with package-override set.
+;; FIXME this is obviously fragile.
+;; Make the (eq base-name package) case below issue a warning if
+;; package-override is nil?
+;; (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))
+ (setq keywords (mapcar 'intern (lm-keywords-list))
package (or package-override
(let ((str (lm-header "package")))
(if str (intern str)))
base-name)
+ summary (or (cdr
+ (assq package finder--builtins-descriptions))
+ (lm-synopsis))
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))
+ (push (cons package
+ (package-make-builtin version summary))
package--builtins))
+ ;; The idea here is that eg calc.el gets to define
+ ;; the description of the calc package.
+ ;; This does not work for eg nxml-mode.el.
((eq base-name package)
(setq desc (cdr entry))
(aset desc 0 version)
(lambda (a b) (string< (symbol-name (car a))
(symbol-name (car b))))))
- (save-excursion
- (find-file generated-finder-keywords-file)
+ (with-current-buffer
+ (find-file-noselect generated-finder-keywords-file)
(setq buffer-undo-list t)
(erase-buffer)
(insert (autoload-rubric generated-finder-keywords-file
"keyword-to-package mapping" t))
(search-backward "\f")
+ ;; FIXME: Now that we have package--builtin-versions, package--builtins is
+ ;; only needed to get the list of unversioned packages and to get the
+ ;; summary description of each package.
(insert "(setq package--builtins '(\n")
(dolist (package package--builtins)
(insert " ")
(packages (gethash id finder-keywords-hash)))
(unless packages
(error "No packages matching key `%s'" key))
- (package--list-packages packages)))
+ (let ((package-list-unversioned t))
+ (package-show-package-list packages))))
(define-button-type 'finder-xref 'action #'finder-goto-xref)
key)))
(defun finder-select ()
- "Select item on current line in a finder buffer."
+ "Select item on current line in a Finder buffer."
(interactive)
(let ((key (finder-current-item)))
(if (string-match "\\.el$" key)
(finder-list-matches key))))
(defun finder-mouse-select (event)
- "Select item in a finder buffer with the mouse."
+ "Select item in a Finder buffer with the mouse."
(interactive "e")
(with-current-buffer (window-buffer (posn-window (event-start event)))
(goto-char (posn-point (event-start event)))
(let ((buf "*Finder*"))
(and (get-buffer buf) (kill-buffer buf))))
+(defun finder-unload-function ()
+ "Unload the Finder library."
+ (with-demoted-errors (unload-feature 'finder-inf t))
+ ;; continue standard unloading
+ nil)
+
\f
(provide 'finder)
HCoop / bpt / emacs.git / blobdiff