X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/83b9062422faef46592618bed64e5df47fe13670..2f67f8a145af8f185f644b1d094a03895a124ef1:/lisp/finder.el

diff --git a/lisp/finder.el b/lisp/finder.el
index 8da589655d..da537a59cc 100644
--- a/lisp/finder.el
+++ b/lisp/finder.el
@@ -1,6 +1,6 @@
 ;;; finder.el --- topic & keyword-based code finder
 
-;; Copyright (C) 1992, 1997-1999, 2001-2013 Free Software Foundation,
+;; Copyright (C) 1992, 1997-1999, 2001-2016 Free Software Foundation,
 ;; Inc.
 
 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
@@ -53,7 +53,7 @@
     (frames     . "Emacs frames and window systems")
     (games	. "games, jokes and amusements")
     (hardware	. "interfacing with system hardware")
-    (help	. "on-line help systems")
+    (help	. "Emacs help systems")
     (hypermedia . "links between text or other media types")
     (i18n	. "internationalization and character-set support")
     (internal	. "code for Emacs internals, build process, defaults")
@@ -73,7 +73,9 @@
     (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))
@@ -103,7 +105,8 @@
     (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)))
@@ -111,12 +114,8 @@
     st)
   "Syntax table used while in `finder-mode'.")
 
-(defvar finder-font-lock-keywords
-  '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
-  "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.
 
@@ -133,22 +132,21 @@ Keywords and package names both should be symbols.")
 ;; 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")
 
-(defun set-generated-finder-keywords-file (file)
-  "Set value of `generated-finder-keywords-file' from FILE.
-
-On systems other than MS-Windows, just sets the value
-of `generated-finder-keywords-file'.  On MS-Windows, converts
-/d/foo/bar form passed by MSYS Make into d:/foo/bar that Emacs
-can grok.  This function is called from lisp/Makefile."
-  (when (and (eq system-type 'windows-nt)
-	     (string-match "\\`/[a-zA-Z]/" file))
-    (setq file (concat (substring file 1 2) ":" (substring file 2))))
-  (setq generated-finder-keywords-file file))
+(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)
@@ -165,6 +163,10 @@ can grok.  This function is called from lisp/Makefile."
     ("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)
@@ -187,11 +189,11 @@ from; the default is `load-path'."
   (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))
-	(message "Directory %s" d)
+	(message "Scanning %s for finder" d)
 	(setq package-override
 	      (intern-soft
 	       (cdr-safe
@@ -202,25 +204,41 @@ from; the default is `load-path'."
 	  (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))
-		    ((eq base-name package)
+		    ;; 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.
+		    ((or (eq base-name package) version)
 		     (setq desc (cdr entry))
 		     (aset desc 0 version)
 		     (aset desc 2 summary)))
@@ -236,13 +254,16 @@ from; the default is `load-path'."
 	      (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 "")
+    ;; 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 "  ")
@@ -329,7 +350,8 @@ not `finder-known-keywords'."
 	 (packages (gethash id finder-keywords-hash)))
     (unless packages
       (error "No packages matching key `%s'" key))
-    (package-show-package-list packages)))
+    (let ((package-list-unversioned t))
+      (package-show-package-list packages))))
 
 (define-button-type 'finder-xref 'action #'finder-goto-xref)
 
@@ -390,7 +412,7 @@ FILE should be in a form suitable for passing to `locate-library'."
       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)
@@ -398,7 +420,7 @@ FILE should be in a form suitable for passing to `locate-library'."
 	(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)))
@@ -437,6 +459,12 @@ Delete the window and kill all Finder-related buffers."
   (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)
+
 
 (provide 'finder)