* configure.ac (--with-sound): Rename ossaudio to bsd-ossaudio,
[emacs.git] / lisp / finder.el
blobe07c6a241ab7e777f5d1f8daef1004553aecae74
1 ;;; finder.el --- topic & keyword-based code finder
3 ;; Copyright (C) 1992, 1997-1999, 2001-2013 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 . "on-line 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")))
78 (defvar finder-mode-map
79 (let ((map (make-sparse-keymap))
80 (menu-map (make-sparse-keymap "Finder")))
81 (define-key map " " 'finder-select)
82 (define-key map "f" 'finder-select)
83 (define-key map [follow-link] 'mouse-face)
84 (define-key map [mouse-2] 'finder-mouse-select)
85 (define-key map "\C-m" 'finder-select)
86 (define-key map "?" 'finder-summary)
87 (define-key map "n" 'next-line)
88 (define-key map "p" 'previous-line)
89 (define-key map "q" 'finder-exit)
90 (define-key map "d" 'finder-list-keywords)
92 (define-key map [menu-bar finder-mode]
93 (cons "Finder" menu-map))
94 (define-key menu-map [finder-exit]
95 '(menu-item "Quit" finder-exit
96 :help "Exit Finder mode"))
97 (define-key menu-map [finder-summary]
98 '(menu-item "Summary" finder-summary
99 :help "Summary item on current line in a finder buffer"))
100 (define-key menu-map [finder-list-keywords]
101 '(menu-item "List keywords" finder-list-keywords
102 :help "Display descriptions of the keywords in the Finder buffer"))
103 (define-key menu-map [finder-select]
104 '(menu-item "Select" finder-select
105 :help "Select item on current line in a finder buffer"))
106 map))
108 (defvar finder-mode-syntax-table
109 (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
110 (modify-syntax-entry ?\; ". " st)
112 "Syntax table used while in `finder-mode'.")
114 (defvar finder-font-lock-keywords
115 '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
116 "Font-lock keywords for Finder mode.")
118 (defvar finder-headmark nil
119 "Internal finder-mode variable, local in finder buffer.")
121 ;;; Code for regenerating the keyword list.
123 (defvar finder-keywords-hash nil
124 "Hash table mapping keywords to lists of package names.
125 Keywords and package names both should be symbols.")
127 (defvar generated-finder-keywords-file "finder-inf.el"
128 "The function `finder-compile-keywords' writes keywords into this file.")
130 ;; Skip autogenerated files, because they will never contain anything
131 ;; useful, and because in parallel builds of Emacs they may get
132 ;; modified while we are trying to read them.
133 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
134 ;; ldefs-boot is not auto-generated, but has nothing useful.
135 (defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
136 cus-load\\|finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
137 "Regexp matching file names not to scan for keywords.")
139 (autoload 'autoload-rubric "autoload")
141 (defvar finder--builtins-alist
142 '(("calc" . calc)
143 ("ede" . ede)
144 ("erc" . erc)
145 ("eshell" . eshell)
146 ("gnus" . gnus)
147 ("international" . emacs)
148 ("language" . emacs)
149 ("mh-e" . mh-e)
150 ("semantic" . semantic)
151 ("analyze" . semantic)
152 ("bovine" . semantic)
153 ("decorate" . semantic)
154 ("symref" . semantic)
155 ("wisent" . semantic)
156 ("nxml" . nxml)
157 ("org" . org)
158 ("srecode" . srecode)
159 ("term" . emacs)
160 ("url" . url))
161 "Alist of built-in package directories.
162 Each element should have the form (DIR . PACKAGE), where DIR is a
163 directory name and PACKAGE is the name of a package (a symbol).
164 When generating `package--builtins', Emacs assumes any file in
165 DIR is part of the package PACKAGE.")
167 (defun finder-compile-keywords (&rest dirs)
168 "Regenerate list of built-in Emacs packages.
169 This recomputes `package--builtins' and `finder-keywords-hash',
170 and prints them into the file `generated-finder-keywords-file'.
172 Optional DIRS is a list of Emacs Lisp directories to compile
173 from; the default is `load-path'."
174 ;; Allow compressed files also.
175 (setq package--builtins nil)
176 (setq finder-keywords-hash (make-hash-table :test 'eq))
177 (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
178 package-override files base-name processed
179 summary keywords package version entry desc)
180 (dolist (d (or dirs load-path))
181 (when (file-exists-p (directory-file-name d))
182 (message "Directory %s" d)
183 (setq package-override
184 (intern-soft
185 (cdr-safe
186 (assoc (file-name-nondirectory (directory-file-name d))
187 finder--builtins-alist))))
188 (setq files (directory-files d nil el-file-regexp))
189 (dolist (f files)
190 (unless (or (string-match finder-no-scan-regexp f)
191 (null (setq base-name
192 (and (string-match el-file-regexp f)
193 (intern (match-string 1 f)))))
194 (memq base-name processed))
195 (push base-name processed)
196 (with-temp-buffer
197 (insert-file-contents (expand-file-name f d))
198 (setq summary (lm-synopsis)
199 keywords (mapcar 'intern (lm-keywords-list))
200 package (or package-override
201 (let ((str (lm-header "package")))
202 (if str (intern str)))
203 base-name)
204 version (lm-header "version")))
205 (when summary
206 (setq version (ignore-errors (version-to-list version)))
207 (setq entry (assq package package--builtins))
208 (cond ((null entry)
209 (push (cons package
210 (package-make-builtin version summary))
211 package--builtins))
212 ((eq base-name package)
213 (setq desc (cdr entry))
214 (aset desc 0 version)
215 (aset desc 2 summary)))
216 (dolist (kw keywords)
217 (puthash kw
218 (cons package
219 (delq package
220 (gethash kw finder-keywords-hash)))
221 finder-keywords-hash))))))))
223 (setq package--builtins
224 (sort package--builtins
225 (lambda (a b) (string< (symbol-name (car a))
226 (symbol-name (car b))))))
228 (save-excursion
229 (find-file generated-finder-keywords-file)
230 (setq buffer-undo-list t)
231 (erase-buffer)
232 (insert (autoload-rubric generated-finder-keywords-file
233 "keyword-to-package mapping" t))
234 (search-backward "\f")
235 ;; FIXME: Now that we have package--builtin-versions, package--builtins is
236 ;; only needed to get the list of unversioned packages and to get the
237 ;; summary description of each package.
238 (insert "(setq package--builtins '(\n")
239 (dolist (package package--builtins)
240 (insert " ")
241 (prin1 package (current-buffer))
242 (insert "\n"))
243 (insert "))\n\n")
244 ;; Insert hash table.
245 (insert "(setq finder-keywords-hash\n ")
246 (prin1 finder-keywords-hash (current-buffer))
247 (insert ")\n")
248 (basic-save-buffer)))
250 (defun finder-compile-keywords-make-dist ()
251 "Regenerate `finder-inf.el' for the Emacs distribution."
252 (apply 'finder-compile-keywords command-line-args-left)
253 (kill-emacs))
255 ;;; Now the retrieval code
257 (defun finder-insert-at-column (column &rest strings)
258 "Insert, at column COLUMN, other args STRINGS."
259 (if (>= (current-column) column) (insert "\n"))
260 (move-to-column column t)
261 (apply 'insert strings))
263 (defvar finder-help-echo nil)
265 (defun finder-mouse-face-on-line ()
266 "Put `mouse-face' and `help-echo' properties on the previous line."
267 (save-excursion
268 (forward-line -1)
269 ;; If finder-insert-at-column moved us to a new line, go back one more.
270 (if (looking-at "[ \t]") (forward-line -1))
271 (unless finder-help-echo
272 (setq finder-help-echo
273 (let* ((keys1 (where-is-internal 'finder-select
274 finder-mode-map))
275 (keys (nconc (where-is-internal
276 'finder-mouse-select finder-mode-map)
277 keys1)))
278 (concat (mapconcat 'key-description keys ", ")
279 ": select item"))))
280 (add-text-properties
281 (line-beginning-position) (line-end-position)
282 '(mouse-face highlight
283 help-echo finder-help-echo))))
285 (defun finder-unknown-keywords ()
286 "Return an alist of unknown keywords and number of their occurrences.
287 Unknown keywords are those present in `finder-keywords-hash' but
288 not `finder-known-keywords'."
289 (let (alist)
290 (maphash (lambda (kw packages)
291 (unless (assq kw finder-known-keywords)
292 (push (cons kw (length packages)) alist)))
293 finder-keywords-hash)
294 (sort alist (lambda (a b) (string< (car a) (car b))))))
296 ;;;###autoload
297 (defun finder-list-keywords ()
298 "Display descriptions of the keywords in the Finder buffer."
299 (interactive)
300 (if (get-buffer "*Finder*")
301 (pop-to-buffer "*Finder*")
302 (pop-to-buffer (get-buffer-create "*Finder*"))
303 (finder-mode)
304 (let ((inhibit-read-only t))
305 (erase-buffer)
306 (dolist (assoc finder-known-keywords)
307 (let ((keyword (car assoc)))
308 (insert (propertize (symbol-name keyword)
309 'font-lock-face 'font-lock-constant-face))
310 (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
311 (finder-mouse-face-on-line)))
312 (goto-char (point-min))
313 (setq finder-headmark (point)
314 buffer-read-only t)
315 (set-buffer-modified-p nil)
316 (balance-windows)
317 (finder-summary))))
319 (defun finder-list-matches (key)
320 (let* ((id (intern key))
321 (packages (gethash id finder-keywords-hash)))
322 (unless packages
323 (error "No packages matching key `%s'" key))
324 (package-show-package-list packages)))
326 (define-button-type 'finder-xref 'action #'finder-goto-xref)
328 (defun finder-goto-xref (button)
329 "Jump to a lisp file for the BUTTON at point."
330 (let* ((file (button-get button 'xref))
331 (lib (locate-library file)))
332 (if lib (finder-commentary lib)
333 (message "Unable to locate `%s'" file))))
335 ;;;###autoload
336 (defun finder-commentary (file)
337 "Display FILE's commentary section.
338 FILE should be in a form suitable for passing to `locate-library'."
339 (interactive
340 (list
341 (completing-read "Library name: "
342 (apply-partially 'locate-file-completion-table
343 (or find-function-source-path load-path)
344 (find-library-suffixes)))))
345 (let ((str (lm-commentary (find-library-name file))))
346 (or str (error "Can't find any Commentary section"))
347 ;; This used to use *Finder* but that would clobber the
348 ;; directory of categories.
349 (pop-to-buffer "*Finder-package*")
350 (setq buffer-read-only nil
351 buffer-undo-list t)
352 (erase-buffer)
353 (insert str)
354 (goto-char (point-min))
355 (delete-blank-lines)
356 (goto-char (point-max))
357 (delete-blank-lines)
358 (goto-char (point-min))
359 (while (re-search-forward "^;+ ?" nil t)
360 (replace-match "" nil nil))
361 (goto-char (point-min))
362 (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
363 (if (locate-library (match-string 1))
364 (make-text-button (match-beginning 1) (match-end 1)
365 'xref (match-string-no-properties 1)
366 'help-echo "Read this file's commentary"
367 :type 'finder-xref)))
368 (goto-char (point-min))
369 (setq buffer-read-only t)
370 (set-buffer-modified-p nil)
371 (shrink-window-if-larger-than-buffer)
372 (finder-mode)
373 (finder-summary)))
375 (defun finder-current-item ()
376 (let ((key (save-excursion
377 (beginning-of-line)
378 (current-word))))
379 (if (or (and finder-headmark (< (point) finder-headmark))
380 (zerop (length key)))
381 (error "No keyword or filename on this line")
382 key)))
384 (defun finder-select ()
385 "Select item on current line in a finder buffer."
386 (interactive)
387 (let ((key (finder-current-item)))
388 (if (string-match "\\.el$" key)
389 (finder-commentary key)
390 (finder-list-matches key))))
392 (defun finder-mouse-select (event)
393 "Select item in a finder buffer with the mouse."
394 (interactive "e")
395 (with-current-buffer (window-buffer (posn-window (event-start event)))
396 (goto-char (posn-point (event-start event)))
397 (finder-select)))
399 ;;;###autoload
400 (defun finder-by-keyword ()
401 "Find packages matching a given keyword."
402 (interactive)
403 (finder-list-keywords))
405 (define-derived-mode finder-mode nil "Finder"
406 "Major mode for browsing package documentation.
407 \\<finder-mode-map>
408 \\[finder-select] more help for the item on the current line
409 \\[finder-exit] exit Finder mode and kill the Finder buffer."
410 :syntax-table finder-mode-syntax-table
411 (setq buffer-read-only t
412 buffer-undo-list t)
413 (set (make-local-variable 'finder-headmark) nil))
415 (defun finder-summary ()
416 "Summarize basic Finder commands."
417 (interactive)
418 (message "%s"
419 (substitute-command-keys
420 "\\<finder-mode-map>\\[finder-select] = select, \
421 \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
422 finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
424 (defun finder-exit ()
425 "Exit Finder mode.
426 Delete the window and kill all Finder-related buffers."
427 (interactive)
428 (ignore-errors (delete-window))
429 (let ((buf "*Finder*"))
430 (and (get-buffer buf) (kill-buffer buf))))
433 (provide 'finder)
435 ;;; finder.el ends here