(coerce, map, maplist, cl-mapc, mapl, mapcan, mapcon, some, every, notany,
[bpt/emacs.git] / lisp / finder.el
index 07d79f8..fb32752 100644 (file)
@@ -1,6 +1,6 @@
 ;;; finder.el --- topic & keyword-based code finder
 
-;; Copyright (C) 1992, 1997, 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1992,97,98,1999,2001,2004  Free Software Foundation, Inc.
 
 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
 ;; Created: 16 Jun 1992
 ;;; Code:
 
 (require 'lisp-mnt)
-(require 'finder-inf)
+(require 'find-func)                   ;for find-library(-suffixes)
+;; Use `load' rather than `require' so that it doesn't get loaded
+;; during byte-compilation (at which point it might be missing).
+(load "finder-inf" t t)
+
+(defvar finder-mode-hook nil
+  "*Hook run when function `finder-mode' is called.")
 
 ;; Local variable in finder buffer.
 (defvar finder-headmark)
 
+;; 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")
     (convenience . "convenience features for faster editing")
-    (data      . "support editing files of data")
+    (data      . "support for editing files of data")
     (docs      . "support for Emacs documentation")
     (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")
     (games     . "games, jokes and amusements")
     (hardware  . "support for interfacing with exotic hardware")
     (mail      . "modes for electronic-mail handling")
     (matching  . "various sorts of searching and matching")
     (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       . "code related to the TeX formatter")
+    (tex       . "supporting code for the TeX formatter")
     (tools     . "programming tools")
-    (unix      . "front-ends/assistants for, or emulators of, UNIX features")
-    (vms       . "support code for vms")
+    (unix      . "front-ends/assistants for, or emulators of, UNIX-like features")
+;; Not a custom group and not currently useful.
+;;    (vms     . "support code for vms")
     (wp                . "word processing")
     ))
 
-(defvar finder-mode-map nil)
-(or finder-mode-map
-    (let ((map (make-sparse-keymap)))
-      (define-key map " "      'finder-select)
-      (define-key map "f"      'finder-select)
-      (define-key map [mouse-2]        'finder-mouse-select)
-      (define-key map "\C-m"   'finder-select)
-      (define-key map "?"      'finder-summary)
-      (define-key map "q"      'finder-exit)
-      (define-key map "d"      'finder-list-keywords)
-      (setq finder-mode-map map)))
+(defvar finder-mode-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map " "        'finder-select)
+    (define-key map "f"        'finder-select)
+    (define-key map [mouse-2]  'finder-mouse-select)
+    (define-key map "\C-m"     'finder-select)
+    (define-key map "?"        'finder-summary)
+    (define-key map "q"        'finder-exit)
+    (define-key map "d"        'finder-list-keywords)
+    map))
 
 
 ;;; Code for regenerating the keyword list.
 (defvar finder-package-info nil
   "Assoc list mapping file names to description & keyword lists.")
 
+(defvar generated-finder-keywords-file "finder-inf.el"
+  "File \\[finder-compile-keywords] puts finder keywords into.")
+
 (defun finder-compile-keywords (&rest dirs)
-  "Regenerate the keywords association list into the file `finder-inf.el'.
-Optional arguments are a list of Emacs Lisp directories to compile from; no
-arguments compiles from `load-path'."
+  "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'."
   (save-excursion
     (let ((processed nil))
-      (find-file "finder-inf.el")
+      (find-file generated-finder-keywords-file)
       (erase-buffer)
-      (insert ";;; finder-inf.el --- keyword-to-package mapping\n")
-      (insert ";; Keywords: help\n")
+      (insert ";;; " (file-name-nondirectory generated-finder-keywords-file)
+             " --- keyword-to-package mapping\n")
+      (insert ";; This file is part of GNU Emacs.\n")
       (insert ";;; Commentary:\n")
       (insert ";; Don't edit this file.  It's generated by finder.el\n\n")
       (insert ";;; Code:\n")
@@ -120,7 +135,7 @@ arguments compiles from `load-path'."
         (when (file-exists-p (directory-file-name d))
           (message "Directory %s" d)
           (mapcar
-           (lambda (f) 
+           (lambda (f)
              (if (and (or (string-match "^[^=].*\\.el$" f)
                           ;; Allow compressed files also.  Fixme:
                           ;; generalize this, especially for
@@ -143,7 +158,7 @@ arguments compiles from `load-path'."
                    (insert
                     (format "    (\"%s\"\n        "
                             (if (string-match "\\.\\(gz\\|Z\\)$" f)
-                                (file-name-sans-extension f) 
+                                (file-name-sans-extension f)
                               f)))
                    (prin1 summary (current-buffer))
                    (insert
@@ -156,9 +171,18 @@ arguments compiles from `load-path'."
                    )))
            (directory-files (or d ".")))))
        (or dirs load-path))
-      (insert "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n")
+      (insert "))\n
+\(provide '" (file-name-sans-extension
+             (file-name-nondirectory generated-finder-keywords-file)) ")
+
+;;; Local Variables:
+;;; version-control: never
+;;; no-byte-compile: t
+;;; no-update-autoloads: t
+;;; End:
+;;; " (file-name-nondirectory generated-finder-keywords-file) " ends here\n")
       (kill-buffer "*finder-scratch*")
-      (eval-current-buffer) ;; So we get the new keyword list immediately
+      (eval-buffer) ;; So we get the new keyword list immediately
       (basic-save-buffer))))
 
 (defun finder-compile-keywords-make-dist ()
@@ -170,18 +194,31 @@ arguments compiles from `load-path'."
 
 (defun finder-insert-at-column (column &rest strings)
   "Insert, at column COLUMN, other args STRINGS."
-  (if (> (current-column) column) (insert "\n"))
+  (if (>= (current-column) column) (insert "\n"))
   (move-to-column column t)
   (apply 'insert strings))
 
+(defvar finder-help-echo nil)
+
 (defun finder-mouse-face-on-line ()
-  "Put a `mouse-face' property on the previous line."
+  "Put `mouse-face' and `help-echo' properties on the previous line."
   (save-excursion
     (previous-line 1)
-    (put-text-property (save-excursion (beginning-of-line) (point))
-                      (progn (end-of-line) (point))
-                      'mouse-face 'highlight)))
-
+    (unless finder-help-echo
+      (setq finder-help-echo
+           (let* ((keys1 (where-is-internal 'finder-select
+                                            finder-mode-map))
+                  (keys (nconc (where-is-internal
+                                'finder-mouse-select finder-mode-map)
+                               keys1)))
+             (concat (mapconcat 'key-description keys ", ")
+                     ": select item"))))
+    (add-text-properties
+     (line-beginning-position) (line-end-position)
+     '(mouse-face highlight
+                 help-echo finder-help-echo))))
+
+;;;###autoload
 (defun finder-list-keywords ()
   "Display descriptions of the keywords in the Finder buffer."
   (interactive)
@@ -191,7 +228,7 @@ arguments compiles from `load-path'."
     (finder-mode)
     (setq buffer-read-only nil)
     (erase-buffer)
-    (mapcar
+    (mapc
      (lambda (assoc)
        (let ((keyword (car assoc)))
         (insert (symbol-name keyword))
@@ -214,7 +251,7 @@ arguments compiles from `load-path'."
     (insert
      "The following packages match the keyword `" key "':\n\n")
     (setq finder-headmark (point))
-    (mapcar
+    (mapc
      (lambda (x)
        (if (memq id (car (cdr (cdr x))))
           (progn
@@ -229,23 +266,23 @@ arguments compiles from `load-path'."
     (shrink-window-if-larger-than-buffer)
     (finder-summary)))
 
-;; Search for a file named FILE on `load-path', also trying compressed
-;; versions if jka-compr is in use.
-(defun finder-find-library (library)
-  (or (locate-library library t)
-      (if (rassq 'jka-compr-handler file-name-handler-alist)
-        (or (locate-library (concat library ".gz") t)
-            (locate-library (concat library ".Z") t)
-            ;; last resort for MS-DOG et al
-            (locate-library (concat library "z"))))))
-
+;;;###autoload
 (defun finder-commentary (file)
-  "Display FILE's commentary section."
-  (interactive)
-  (let* ((str (lm-commentary (finder-find-library file))))
+  "Display FILE's commentary section.
+FILE should be in a form suitable for passing to `locate-library'."
+  (interactive
+   (list
+    (completing-read "Library name: "
+                    'locate-file-completion
+                    (cons (or find-function-source-path load-path)
+                          (find-library-suffixes)))))
+  (let* ((str (lm-commentary (find-library-name file))))
     (if (null str)
        (error "Can't find any Commentary section"))
-    (pop-to-buffer "*Finder*")
+    ;; This used to use *Finder* but that would clobber the
+    ;; directory of categories.
+    (delete-other-windows)
+    (pop-to-buffer "*Finder-package*")
     (setq buffer-read-only nil)
     (erase-buffer)
     (insert str)
@@ -260,14 +297,17 @@ arguments compiles from `load-path'."
     (setq buffer-read-only t)
     (set-buffer-modified-p nil)
     (shrink-window-if-larger-than-buffer)
+    (finder-mode)
     (finder-summary)))
 
 (defun finder-current-item ()
-  (if (and finder-headmark (< (point) finder-headmark))
-      (error "No keyword or filename on this line")
-    (save-excursion
-      (beginning-of-line)
-      (current-word))))
+  (let ((key (save-excursion
+              (beginning-of-line)
+              (current-word))))
+    (if (or (and finder-headmark (< (point) finder-headmark))
+           (= (length key) 0))
+       (error "No keyword or filename on this line")
+      key)))
 
 (defun finder-select ()
   "Select item on current line in a finder buffer."
@@ -285,6 +325,7 @@ arguments compiles from `load-path'."
     (goto-char (posn-point (event-start event)))
     (finder-select)))
 
+;;;###autoload
 (defun finder-by-keyword ()
   "Find packages matching a given keyword."
   (interactive)
@@ -294,15 +335,15 @@ arguments compiles from `load-path'."
   "Major mode for browsing package documentation.
 \\<finder-mode-map>
 \\[finder-select]      more help for the item on the current line
-\\[finder-exit]        exit Finder mode and kill the Finder buffer.
-"
+\\[finder-exit]        exit Finder mode and kill the Finder buffer."
   (interactive)
+  (kill-all-local-variables)
   (use-local-map finder-mode-map)
   (set-syntax-table emacs-lisp-mode-syntax-table)
   (setq mode-name "Finder")
   (setq major-mode 'finder-mode)
-  (make-local-variable 'finder-headmark)
-  (setq finder-headmark nil))
+  (set (make-local-variable 'finder-headmark) nil)
+  (run-mode-hooks 'finder-mode-hook))
 
 (defun finder-summary ()
   "Summarize basic Finder commands."
@@ -324,6 +365,8 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
   (and (get-buffer "*Finder Category*")
        (kill-buffer "*Finder Category*")))
 
+\f
 (provide 'finder)
 
+;;; arch-tag: ec85ff49-8cb8-41f5-a63f-9131d53ce2c5
 ;;; finder.el ends here