finder.el 15 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; finder.el --- topic & keyword-based code finder

3
;; Copyright (C) 1992, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2006, 2007, 2008, 2009, 2010  Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
5 6 7 8 9 10 11 12

;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
;; Version: 1.0
;; Keywords: help

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Eric S. Raymond's avatar
Eric S. Raymond committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Eric S. Raymond's avatar
Eric S. Raymond committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
25

26
;;; Commentary:
Eric S. Raymond's avatar
Eric S. Raymond committed
27 28 29 30 31 32 33

;; This mode uses the Keywords library header to provide code-finding
;; services by keyword.

;;; Code:

(require 'lisp-mnt)
34
(require 'find-func)			;for find-library(-suffixes)
35 36
;; Use `load' rather than `require' so that it doesn't get loaded
;; during byte-compilation (at which point it might be missing).
37
(load "finder-inf" t t)
Eric S. Raymond's avatar
Eric S. Raymond committed
38

Dave Love's avatar
Dave Love committed
39 40
;; These are supposed to correspond to top-level customization groups,
;; says rms.
Eric S. Raymond's avatar
Eric S. Raymond committed
41 42
(defvar finder-known-keywords
  '(
Eric S. Raymond's avatar
Eric S. Raymond committed
43
    (abbrev	. "abbreviation handling, typing shortcuts, macros")
44
    ;; Too specific:
45
    (bib	. "code related to the `bib' bibliography processor")
46
    (c		. "support for the C language and related languages")
Eric S. Raymond's avatar
Eric S. Raymond committed
47
    (calendar	. "calendar and time management support")
Eric S. Raymond's avatar
Eric S. Raymond committed
48
    (comm	. "communications, networking, remote access to files")
49
    (convenience . "convenience features for faster editing")
50
    (data	. "support for editing files of data")
Eric S. Raymond's avatar
Eric S. Raymond committed
51 52 53
    (docs	. "support for Emacs documentation")
    (emulations	. "emulations of other editors")
    (extensions	. "Emacs Lisp language extensions")
54
    (faces	. "support for multiple fonts")
55
    (files      . "support for editing and manipulating files")
Richard M. Stallman's avatar
Richard M. Stallman committed
56
    (frames     . "support for Emacs frames and window systems")
Eric S. Raymond's avatar
Eric S. Raymond committed
57 58 59
    (games	. "games, jokes and amusements")
    (hardware	. "support for interfacing with exotic hardware")
    (help	. "support for on-line help systems")
Richard M. Stallman's avatar
Richard M. Stallman committed
60
    (hypermedia . "support for links between text or other media types")
61
    (i18n	. "internationalization and alternate character-set support")
Eric S. Raymond's avatar
Eric S. Raymond committed
62 63 64 65 66 67
    (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")
68 69
    (matching	. "various sorts of searching and matching")
    (mouse	. "mouse support")
70
    (multimedia . "images and sound support")
Eric S. Raymond's avatar
Eric S. Raymond committed
71
    (news	. "support for netnews reading and posting")
Richard M. Stallman's avatar
Richard M. Stallman committed
72 73
    (oop        . "support for object-oriented programming")
    (outlines   . "support for hierarchical outlining")
Eric S. Raymond's avatar
Eric S. Raymond committed
74 75
    (processes	. "process, subshell, compilation, and job control support")
    (terminals	. "support for terminal types")
76
    (tex	. "supporting code for the TeX formatter")
Eric S. Raymond's avatar
Eric S. Raymond committed
77
    (tools	. "programming tools")
78
    (unix	. "front-ends/assistants for, or emulators of, UNIX-like features")
Eric S. Raymond's avatar
Eric S. Raymond committed
79 80 81
    (wp		. "word processing")
    ))

82
(defvar finder-mode-map
83 84
  (let ((map (make-sparse-keymap))
	(menu-map (make-sparse-keymap "Finder")))
85 86
    (define-key map " "	'finder-select)
    (define-key map "f"	'finder-select)
87
    (define-key map [follow-link] 'mouse-face)
88 89 90
    (define-key map [mouse-2]	'finder-mouse-select)
    (define-key map "\C-m"	'finder-select)
    (define-key map "?"	'finder-summary)
91 92
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
93 94
    (define-key map "q"	'finder-exit)
    (define-key map "d"	'finder-list-keywords)
95 96 97 98 99 100 101 102 103 104 105 106 107 108 109

    (define-key map [menu-bar finder-mode]
      (cons "Finder" menu-map))
    (define-key menu-map [finder-exit]
      '(menu-item "Quit" finder-exit
		  :help "Exit Finder mode"))
    (define-key menu-map [finder-summary]
      '(menu-item "Summary" finder-summary
		  :help "Summary item on current line in a finder buffer"))
    (define-key menu-map [finder-list-keywords]
      '(menu-item "List keywords" finder-list-keywords
		  :help "Display descriptions of the keywords in the Finder buffer"))
    (define-key menu-map [finder-select]
      '(menu-item "Select" finder-select
		  :help "Select item on current line in a finder buffer"))
110
    map))
111

112 113 114 115 116 117 118
(defvar finder-mode-syntax-table
  (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
    (modify-syntax-entry ?\; ".   " st)
    st)
  "Syntax table used while in `finder-mode'.")

(defvar finder-font-lock-keywords
119
  '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
120 121
  "Font-lock keywords for Finder mode.")

122 123
(defvar finder-headmark nil
  "Internal finder-mode variable, local in finder buffer.")
124

Eric S. Raymond's avatar
Eric S. Raymond committed
125 126 127 128 129
;;; Code for regenerating the keyword list.

(defvar finder-package-info nil
  "Assoc list mapping file names to description & keyword lists.")

130
(defvar generated-finder-keywords-file "finder-inf.el"
131 132 133 134 135 136
  "The function `finder-compile-keywords' writes keywords into this file.")

;; Skip autogenerated files, because they will never contain anything
;; useful, and because in parallel builds of Emacs they may get
;; modified while we are trying to read them.
;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
137 138 139
;; 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$\\)"
140 141 142
  "Regexp matching file names not to scan for keywords.")

(autoload 'autoload-rubric "autoload")
143

Eric S. Raymond's avatar
Eric S. Raymond committed
144
(defun finder-compile-keywords (&rest dirs)
145
  "Regenerate the keywords association list into `generated-finder-keywords-file'.
146 147
Optional arguments DIRS are a list of Emacs Lisp directories to compile from;
no arguments compiles from `load-path'."
Eric S. Raymond's avatar
Eric S. Raymond committed
148
  (save-excursion
149 150 151 152
    (find-file generated-finder-keywords-file)
    (setq buffer-undo-list t)
    (erase-buffer)
    (insert (autoload-rubric generated-finder-keywords-file
153
                             "keyword-to-package mapping" t))
154 155
    (search-backward "")
    (insert "(setq finder-package-info '(\n")
156
    (let (processed summary keywords)
157
      (mapc
Erik Naggum's avatar
Erik Naggum committed
158
       (lambda (d)
159 160
	 (when (file-exists-p (directory-file-name d))
	   (message "Directory %s" d)
161
	   (mapc
162
	    (lambda (f)
163 164 165 166 167 168 169
              ;; 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)
170
                        keywords (lm-keywords-list)))
171 172 173 174 175 176 177
                (insert
                 (format "    (\"%s\"\n        "
                         (if (string-match "\\.\\(gz\\|Z\\)$" f)
                             (file-name-sans-extension f)
                           f)))
                (prin1 summary (current-buffer))
                (insert "\n        ")
Juri Linkov's avatar
Juri Linkov committed
178
                (prin1 (mapcar 'intern keywords) (current-buffer))
179
                (insert ")\n")))
180 181 182 183 184 185
	    (directory-files d nil
                             ;; Allow compressed files also.  FIXME:
                             ;; generalize this, especially for
                             ;; MS-DOG-type filenames.
                             "^[^=].*\\.el\\(\\.\\(gz\\|Z\\)\\)?$"
                             ))))
186 187 188 189
       (or dirs load-path)))
    (insert "    ))\n")
    (eval-buffer)         ; so we get the new keyword list immediately
    (basic-save-buffer)))
Eric S. Raymond's avatar
Eric S. Raymond committed
190

191 192
(defun finder-compile-keywords-make-dist ()
  "Regenerate `finder-inf.el' for the Emacs distribution."
193 194
  (apply 'finder-compile-keywords command-line-args-left)
  (kill-emacs))
195

Eric S. Raymond's avatar
Eric S. Raymond committed
196 197
;;; Now the retrieval code

Erik Naggum's avatar
Erik Naggum committed
198
(defun finder-insert-at-column (column &rest strings)
199
  "Insert, at column COLUMN, other args STRINGS."
200
  (if (>= (current-column) column) (insert "\n"))
201
  (move-to-column column t)
Erik Naggum's avatar
Erik Naggum committed
202 203
  (apply 'insert strings))

204 205
(defvar finder-help-echo nil)

206
(defun finder-mouse-face-on-line ()
207
  "Put `mouse-face' and `help-echo' properties on the previous line."
208
  (save-excursion
209
    (forward-line -1)
210 211
    ;; If finder-insert-at-column moved us to a new line, go back one more.
    (if (looking-at "[ \t]") (forward-line -1))
212 213 214 215 216 217 218 219 220 221 222 223 224
    (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))))
225

Juri Linkov's avatar
Juri Linkov committed
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248
(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))))))

249
;;;###autoload
250 251 252
(defun finder-list-keywords ()
  "Display descriptions of the keywords in the Finder buffer."
  (interactive)
253 254
  (if (get-buffer "*Finder*")
      (pop-to-buffer "*Finder*")
255
    (pop-to-buffer (get-buffer-create "*Finder*"))
256
    (finder-mode)
257 258
    (setq buffer-read-only nil
          buffer-undo-list t)
259
    (erase-buffer)
260
    (mapc
261 262 263 264
     (lambda (assoc)
       (let ((keyword (car assoc)))
	 (insert (symbol-name keyword))
	 (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
265
	 (finder-mouse-face-on-line)))
266 267
     finder-known-keywords)
    (goto-char (point-min))
268 269
    (setq finder-headmark (point)
          buffer-read-only t)
270 271 272
    (set-buffer-modified-p nil)
    (balance-windows)
    (finder-summary)))
273 274

(defun finder-list-matches (key)
275
  (pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*")))
276
  (finder-mode)
277 278
  (setq buffer-read-only nil
         buffer-undo-list t)
279 280 281 282
  (erase-buffer)
  (let ((id (intern key)))
    (insert
     "The following packages match the keyword `" key "':\n\n")
283
    (setq finder-headmark (point))
284
    (mapc
Erik Naggum's avatar
Erik Naggum committed
285
     (lambda (x)
286 287 288 289
       (when (memq id (cadr (cdr x)))
         (insert (car x))
         (finder-insert-at-column 16 (concat (cadr x) "\n"))
         (finder-mouse-face-on-line)))
290 291 292 293 294 295 296 297
     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)))

298 299 300 301 302 303 304 305 306
(define-button-type 'finder-xref 'action #'finder-goto-xref)

(defun finder-goto-xref (button)
  "Jump to a lisp file for the BUTTON at point."
  (let* ((file (button-get button 'xref))
         (lib (locate-library file)))
    (if lib (finder-commentary lib)
      (message "Unable to locate `%s'" file))))

307
;;;###autoload
308
(defun finder-commentary (file)
309 310
  "Display FILE's commentary section.
FILE should be in a form suitable for passing to `locate-library'."
311 312 313
  (interactive
   (list
    (completing-read "Library name: "
314 315 316
		     (apply-partially 'locate-file-completion-table
                                      (or find-function-source-path load-path)
                                      (find-library-suffixes)))))
317 318
  (let ((str (lm-commentary (find-library-name file))))
    (or str (error "Can't find any Commentary section"))
319 320 321
    ;; This used to use *Finder* but that would clobber the
    ;; directory of categories.
    (pop-to-buffer "*Finder-package*")
322 323
    (setq buffer-read-only nil
          buffer-undo-list t)
324 325 326 327 328 329 330 331 332 333
    (erase-buffer)
    (insert str)
    (goto-char (point-min))
    (delete-blank-lines)
    (goto-char (point-max))
    (delete-blank-lines)
    (goto-char (point-min))
    (while (re-search-forward "^;+ ?" nil t)
      (replace-match "" nil nil))
    (goto-char (point-min))
334 335 336 337 338 339 340
    (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
      (if (locate-library (match-string 1))
          (make-text-button (match-beginning 1) (match-end 1)
                            'xref (match-string-no-properties 1)
                            'help-echo "Read this file's commentary"
                            :type 'finder-xref)))
    (goto-char (point-min))
341 342 343
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)
    (shrink-window-if-larger-than-buffer)
344
    (finder-mode)
Erik Naggum's avatar
Erik Naggum committed
345
    (finder-summary)))
346 347

(defun finder-current-item ()
348 349 350 351
  (let ((key (save-excursion
	       (beginning-of-line)
	       (current-word))))
    (if (or (and finder-headmark (< (point) finder-headmark))
352
	    (zerop (length key)))
353 354
	(error "No keyword or filename on this line")
      key)))
355 356

(defun finder-select ()
357
  "Select item on current line in a finder buffer."
358 359
  (interactive)
  (let ((key (finder-current-item)))
360 361 362 363 364
      (if (string-match "\\.el$" key)
	  (finder-commentary key)
	(finder-list-matches key))))

(defun finder-mouse-select (event)
365
  "Select item in a finder buffer with the mouse."
366
  (interactive "e")
367
  (with-current-buffer (window-buffer (posn-window (event-start event)))
368 369
    (goto-char (posn-point (event-start event)))
    (finder-select)))
370

371
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
372 373 374
(defun finder-by-keyword ()
  "Find packages matching a given keyword."
  (interactive)
375 376
  (finder-list-keywords))

377
(define-derived-mode finder-mode nil "Finder"
378
  "Major mode for browsing package documentation.
379
\\<finder-mode-map>
380
\\[finder-select]	more help for the item on the current line
381
\\[finder-exit]	exit Finder mode and kill the Finder buffer."
382
  :syntax-table finder-mode-syntax-table
383 384
  (setq font-lock-defaults '(finder-font-lock-keywords nil nil
                             (("+-*/.<>=!?$%_&~^:@" . "w")) nil))
385
  (set (make-local-variable 'finder-headmark) nil))
386 387 388 389

(defun finder-summary ()
  "Summarize basic Finder commands."
  (interactive)
390
  (message "%s"
391
   (substitute-command-keys
392 393 394
    "\\<finder-mode-map>\\[finder-select] = select, \
\\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
395

396
(defun finder-exit ()
397
  "Exit Finder mode.
398
Delete the window and kill all Finder-related buffers."
399
  (interactive)
400 401 402
  (ignore-errors (delete-window))
  (dolist (buff '("*Finder*" "*Finder-package*" "*Finder Category*"))
    (and (get-buffer buff) (kill-buffer buff))))
Eric S. Raymond's avatar
Eric S. Raymond committed
403

404

Eric S. Raymond's avatar
Eric S. Raymond committed
405 406
(provide 'finder)

407
;; arch-tag: ec85ff49-8cb8-41f5-a63f-9131d53ce2c5
Eric S. Raymond's avatar
Eric S. Raymond committed
408
;;; finder.el ends here