Fix a comment whitespace typo.
[emacs.git] / lisp / finder.el
blob361572f7c2de7fc644b525cf4e9ff88ac9a17160
1 ;;; finder.el --- topic & keyword-based code finder
3 ;; Copyright (C) 1992, 1997-1999, 2001-2017 Free Software Foundation,
4 ;; Inc.
6 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
7 ;; Created: 16 Jun 1992
8 ;; Version: 1.0
9 ;; Keywords: help
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; 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/>.
26 ;;; Commentary:
28 ;; This mode uses the Keywords library header to provide code-finding
29 ;; services by keyword.
31 ;;; Code:
33 (require 'package)
34 (require 'lisp-mnt)
35 (require 'find-func) ;for find-library(-suffixes)
36 (require 'finder-inf nil t)
38 ;; These are supposed to correspond to top-level customization groups,
39 ;; says rms.
40 (defvar finder-known-keywords
41 '((abbrev . "abbreviation handling, typing shortcuts, and macros")
42 (bib . "bibliography processors")
43 (c . "C and related programming languages")
44 (calendar . "calendar and time management tools")
45 (comm . "communications, networking, and remote file access")
46 (convenience . "convenience features for faster editing")
47 (data . "editing data (non-text) files")
48 (docs . "Emacs documentation facilities")
49 (emulations . "emulations of other editors")
50 (extensions . "Emacs Lisp language extensions")
51 (faces . "fonts and colors for text")
52 (files . "file editing and manipulation")
53 (frames . "Emacs frames and window systems")
54 (games . "games, jokes and amusements")
55 (hardware . "interfacing with system hardware")
56 (help . "Emacs help systems")
57 (hypermedia . "links between text or other media types")
58 (i18n . "internationalization and character-set support")
59 (internal . "code for Emacs internals, build process, defaults")
60 (languages . "specialized modes for editing programming languages")
61 (lisp . "Lisp support, including Emacs Lisp")
62 (local . "code local to your site")
63 (maint . "Emacs development tools and aids")
64 (mail . "email reading and posting")
65 (matching . "searching, matching, and sorting")
66 (mouse . "mouse support")
67 (multimedia . "images and sound")
68 (news . "USENET news reading and posting")
69 (outlines . "hierarchical outlining and note taking")
70 (processes . "processes, subshells, and compilation")
71 (terminals . "text terminals (ttys)")
72 (tex . "the TeX document formatter")
73 (tools . "programming tools")
74 (unix . "UNIX feature interfaces and emulators")
75 (vc . "version control")
76 (wp . "word processing"))
77 "Association list of the standard \"Keywords:\" headers.
78 Each element has the form (KEYWORD . DESCRIPTION).")
80 (defvar finder-mode-map
81 (let ((map (make-sparse-keymap))
82 (menu-map (make-sparse-keymap "Finder")))
83 (define-key map " " 'finder-select)
84 (define-key map "f" 'finder-select)
85 (define-key map [follow-link] 'mouse-face)
86 (define-key map [mouse-2] 'finder-mouse-select)
87 (define-key map "\C-m" 'finder-select)
88 (define-key map "?" 'finder-summary)
89 (define-key map "n" 'next-line)
90 (define-key map "p" 'previous-line)
91 (define-key map "q" 'finder-exit)
92 (define-key map "d" 'finder-list-keywords)
94 (define-key map [menu-bar finder-mode]
95 (cons "Finder" menu-map))
96 (define-key menu-map [finder-exit]
97 '(menu-item "Quit" finder-exit
98 :help "Exit Finder mode"))
99 (define-key menu-map [finder-summary]
100 '(menu-item "Summary" finder-summary
101 :help "Summary item on current line in a finder buffer"))
102 (define-key menu-map [finder-list-keywords]
103 '(menu-item "List keywords" finder-list-keywords
104 :help "Display descriptions of the keywords in the Finder buffer"))
105 (define-key menu-map [finder-select]
106 '(menu-item "Select" finder-select
107 :help "Select item on current line in a finder buffer"))
108 map)
109 "Keymap used in `finder-mode'.")
111 (defvar finder-mode-syntax-table
112 (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
113 (modify-syntax-entry ?\; ". " st)
115 "Syntax table used while in `finder-mode'.")
117 (defvar finder-headmark nil
118 "Internal Finder mode variable, local in Finder buffer.")
120 ;;; Code for regenerating the keyword list.
122 (defvar finder-keywords-hash nil
123 "Hash table mapping keywords to lists of package names.
124 Keywords and package names both should be symbols.")
126 (defvar generated-finder-keywords-file "finder-inf.el"
127 "The function `finder-compile-keywords' writes keywords into this file.")
129 ;; Skip autogenerated files, because they will never contain anything
130 ;; useful, and because in parallel builds of Emacs they may get
131 ;; modified while we are trying to read them.
132 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
133 ;; ldefs-boot is not auto-generated, but has nothing useful.
134 (defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
135 cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
136 "Regexp matching file names not to scan for keywords.")
138 (autoload 'autoload-rubric "autoload")
140 (defconst finder--builtins-descriptions
141 ;; I have no idea whether these are supposed to be capitalized
142 ;; and/or end in a full-stop. Existing file headers are inconsistent,
143 ;; but mainly seem to not do so.
144 '((emacs . "the extensible text editor")
145 (nxml . "a new XML mode"))
146 "Alist of built-in package descriptions.
147 Entries have the form (PACKAGE-SYMBOL . DESCRIPTION).
148 When generating `package--builtins', this overrides what the description
149 would otherwise be.")
151 (defvar finder--builtins-alist
152 '(("calc" . calc)
153 ("ede" . ede)
154 ("erc" . erc)
155 ("eshell" . eshell)
156 ("gnus" . gnus)
157 ("international" . emacs)
158 ("language" . emacs)
159 ("mh-e" . mh-e)
160 ("semantic" . semantic)
161 ("analyze" . semantic)
162 ("bovine" . semantic)
163 ("decorate" . semantic)
164 ("symref" . semantic)
165 ("wisent" . semantic)
166 ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el
167 ;; is the main file for the package. Then we would not need an
168 ;; entry in finder--builtins-descriptions. But I do not know if
169 ;; it is safe to change this, in case it is already in use.
170 ("nxml" . nxml)
171 ("org" . org)
172 ("srecode" . srecode)
173 ("term" . emacs)
174 ("url" . url))
175 "Alist of built-in package directories.
176 Each element should have the form (DIR . PACKAGE), where DIR is a
177 directory name and PACKAGE is the name of a package (a symbol).
178 When generating `package--builtins', Emacs assumes any file in
179 DIR is part of the package PACKAGE.")
181 (defun finder-compile-keywords (&rest dirs)
182 "Regenerate list of built-in Emacs packages.
183 This recomputes `package--builtins' and `finder-keywords-hash',
184 and prints them into the file `generated-finder-keywords-file'.
186 Optional DIRS is a list of Emacs Lisp directories to compile
187 from; the default is `load-path'."
188 ;; Allow compressed files also.
189 (setq package--builtins nil)
190 (setq finder-keywords-hash (make-hash-table :test 'eq))
191 (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
192 package-override files base-name ; processed
193 summary keywords package version entry desc)
194 (dolist (d (or dirs load-path))
195 (when (file-exists-p (directory-file-name d))
196 (message "Scanning %s for finder" d)
197 (setq package-override
198 (intern-soft
199 (cdr-safe
200 (assoc (file-name-nondirectory (directory-file-name d))
201 finder--builtins-alist))))
202 (setq files (directory-files d nil el-file-regexp))
203 (dolist (f files)
204 (unless (or (string-match finder-no-scan-regexp f)
205 (null (setq base-name
206 (and (string-match el-file-regexp f)
207 (intern (match-string 1 f))))))
208 ;; (memq base-name processed))
209 ;; There are multiple files in the tree with the same basename.
210 ;; So skipping files based on basename means you randomly (depending
211 ;; on which order the files are traversed in) miss some packages.
212 ;; http://debbugs.gnu.org/14010
213 ;; You might think this could lead to two files providing the same package,
214 ;; but it does not, because the duplicates are (at time of writing)
215 ;; all due to files in cedet, which end up with package-override set.
216 ;; FIXME this is obviously fragile.
217 ;; Make the (eq base-name package) case below issue a warning if
218 ;; package-override is nil?
219 ;; (push base-name processed)
220 (with-temp-buffer
221 (insert-file-contents (expand-file-name f d))
222 (setq keywords (mapcar 'intern (lm-keywords-list))
223 package (or package-override
224 (let ((str (lm-header "package")))
225 (if str (intern str)))
226 base-name)
227 summary (or (cdr
228 (assq package finder--builtins-descriptions))
229 (lm-synopsis))
230 version (lm-header "version")))
231 (when summary
232 (setq version (ignore-errors (version-to-list version)))
233 (setq entry (assq package package--builtins))
234 (cond ((null entry)
235 (push (cons package
236 (package-make-builtin version summary))
237 package--builtins))
238 ;; The idea here is that eg calc.el gets to define
239 ;; the description of the calc package.
240 ;; This does not work for eg nxml-mode.el.
241 ((or (eq base-name package) version)
242 (setq desc (cdr entry))
243 (aset desc 0 version)
244 (aset desc 2 summary)))
245 (dolist (kw keywords)
246 (puthash kw
247 (cons package
248 (delq package
249 (gethash kw finder-keywords-hash)))
250 finder-keywords-hash))))))))
252 (setq package--builtins
253 (sort package--builtins
254 (lambda (a b) (string< (symbol-name (car a))
255 (symbol-name (car b))))))
257 (with-current-buffer
258 (find-file-noselect generated-finder-keywords-file)
259 (setq buffer-undo-list t)
260 (erase-buffer)
261 (insert (autoload-rubric generated-finder-keywords-file
262 "keyword-to-package mapping" t))
263 (search-backward "\f")
264 ;; FIXME: Now that we have package--builtin-versions, package--builtins is
265 ;; only needed to get the list of unversioned packages and to get the
266 ;; summary description of each package.
267 (insert "(setq package--builtins '(\n")
268 (dolist (package package--builtins)
269 (insert " ")
270 (prin1 package (current-buffer))
271 (insert "\n"))
272 (insert "))\n\n")
273 ;; Insert hash table.
274 (insert "(setq finder-keywords-hash\n ")
275 (prin1 finder-keywords-hash (current-buffer))
276 (insert ")\n")
277 (basic-save-buffer)))
279 (defun finder-compile-keywords-make-dist ()
280 "Regenerate `finder-inf.el' for the Emacs distribution."
281 (apply 'finder-compile-keywords command-line-args-left)
282 (kill-emacs))
284 ;;; Now the retrieval code
286 (defun finder-insert-at-column (column &rest strings)
287 "Insert, at column COLUMN, other args STRINGS."
288 (if (>= (current-column) column) (insert "\n"))
289 (move-to-column column t)
290 (apply 'insert strings))
292 (defvar finder-help-echo nil)
294 (defun finder-mouse-face-on-line ()
295 "Put `mouse-face' and `help-echo' properties on the previous line."
296 (save-excursion
297 (forward-line -1)
298 ;; If finder-insert-at-column moved us to a new line, go back one more.
299 (if (looking-at "[ \t]") (forward-line -1))
300 (unless finder-help-echo
301 (setq finder-help-echo
302 (let* ((keys1 (where-is-internal 'finder-select
303 finder-mode-map))
304 (keys (nconc (where-is-internal
305 'finder-mouse-select finder-mode-map)
306 keys1)))
307 (concat (mapconcat 'key-description keys ", ")
308 ": select item"))))
309 (add-text-properties
310 (line-beginning-position) (line-end-position)
311 '(mouse-face highlight
312 help-echo finder-help-echo))))
314 (defun finder-unknown-keywords ()
315 "Return an alist of unknown keywords and number of their occurrences.
316 Unknown keywords are those present in `finder-keywords-hash' but
317 not `finder-known-keywords'."
318 (let (alist)
319 (maphash (lambda (kw packages)
320 (unless (assq kw finder-known-keywords)
321 (push (cons kw (length packages)) alist)))
322 finder-keywords-hash)
323 (sort alist (lambda (a b) (string< (car a) (car b))))))
325 ;;;###autoload
326 (defun finder-list-keywords ()
327 "Display descriptions of the keywords in the Finder buffer."
328 (interactive)
329 (if (get-buffer "*Finder*")
330 (pop-to-buffer "*Finder*")
331 (pop-to-buffer (get-buffer-create "*Finder*"))
332 (finder-mode)
333 (let ((inhibit-read-only t))
334 (erase-buffer)
335 (dolist (assoc finder-known-keywords)
336 (let ((keyword (car assoc)))
337 (insert (propertize (symbol-name keyword)
338 'font-lock-face 'font-lock-constant-face))
339 (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
340 (finder-mouse-face-on-line)))
341 (goto-char (point-min))
342 (setq finder-headmark (point)
343 buffer-read-only t)
344 (set-buffer-modified-p nil)
345 (balance-windows)
346 (finder-summary))))
348 (defun finder-list-matches (key)
349 (let* ((id (intern key))
350 (packages (gethash id finder-keywords-hash)))
351 (unless packages
352 (error "No packages matching key `%s'" key))
353 (let ((package-list-unversioned t))
354 (package-show-package-list packages))))
356 (define-button-type 'finder-xref 'action #'finder-goto-xref)
358 (defun finder-goto-xref (button)
359 "Jump to a lisp file for the BUTTON at point."
360 (let* ((file (button-get button 'xref))
361 (lib (locate-library file)))
362 (if lib (finder-commentary lib)
363 (message "Unable to locate `%s'" file))))
365 ;;;###autoload
366 (defun finder-commentary (file)
367 "Display FILE's commentary section.
368 FILE should be in a form suitable for passing to `locate-library'."
369 (interactive
370 (list
371 (completing-read "Library name: "
372 (apply-partially 'locate-file-completion-table
373 (or find-function-source-path load-path)
374 (find-library-suffixes)))))
375 (let ((str (lm-commentary (find-library-name file))))
376 (or str (error "Can't find any Commentary section"))
377 ;; This used to use *Finder* but that would clobber the
378 ;; directory of categories.
379 (pop-to-buffer "*Finder-package*")
380 (setq buffer-read-only nil
381 buffer-undo-list t)
382 (erase-buffer)
383 (insert str)
384 (goto-char (point-min))
385 (delete-blank-lines)
386 (goto-char (point-max))
387 (delete-blank-lines)
388 (goto-char (point-min))
389 (while (re-search-forward "^;+ ?" nil t)
390 (replace-match "" nil nil))
391 (goto-char (point-min))
392 (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
393 (if (locate-library (match-string 1))
394 (make-text-button (match-beginning 1) (match-end 1)
395 'xref (match-string-no-properties 1)
396 'help-echo "Read this file's commentary"
397 :type 'finder-xref)))
398 (goto-char (point-min))
399 (setq buffer-read-only t)
400 (set-buffer-modified-p nil)
401 (shrink-window-if-larger-than-buffer)
402 (finder-mode)
403 (finder-summary)))
405 (defun finder-current-item ()
406 (let ((key (save-excursion
407 (beginning-of-line)
408 (current-word))))
409 (if (or (and finder-headmark (< (point) finder-headmark))
410 (zerop (length key)))
411 (error "No keyword or filename on this line")
412 key)))
414 (defun finder-select ()
415 "Select item on current line in a Finder buffer."
416 (interactive)
417 (let ((key (finder-current-item)))
418 (if (string-match "\\.el$" key)
419 (finder-commentary key)
420 (finder-list-matches key))))
422 (defun finder-mouse-select (event)
423 "Select item in a Finder buffer with the mouse."
424 (interactive "e")
425 (with-current-buffer (window-buffer (posn-window (event-start event)))
426 (goto-char (posn-point (event-start event)))
427 (finder-select)))
429 ;;;###autoload
430 (defun finder-by-keyword ()
431 "Find packages matching a given keyword."
432 (interactive)
433 (finder-list-keywords))
435 (define-derived-mode finder-mode nil "Finder"
436 "Major mode for browsing package documentation.
437 \\<finder-mode-map>
438 \\[finder-select] more help for the item on the current line
439 \\[finder-exit] exit Finder mode and kill the Finder buffer."
440 :syntax-table finder-mode-syntax-table
441 (setq buffer-read-only t
442 buffer-undo-list t)
443 (set (make-local-variable 'finder-headmark) nil))
445 (defun finder-summary ()
446 "Summarize basic Finder commands."
447 (interactive)
448 (message "%s"
449 (substitute-command-keys
450 "\\<finder-mode-map>\\[finder-select] = select, \
451 \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
452 finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
454 (defun finder-exit ()
455 "Exit Finder mode.
456 Delete the window and kill all Finder-related buffers."
457 (interactive)
458 (ignore-errors (delete-window))
459 (let ((buf "*Finder*"))
460 (and (get-buffer buf) (kill-buffer buf))))
462 (defun finder-unload-function ()
463 "Unload the Finder library."
464 (with-demoted-errors (unload-feature 'finder-inf t))
465 ;; continue standard unloading
466 nil)
469 (provide 'finder)
471 ;;; finder.el ends here