* lisp/help-fns.el (help-split-fundoc): Don't insert byte-compiled body.
[emacs.git] / lisp / finder.el
blob3d988b41bdef3d99eabe86bd214e4d9efe5337d0
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 (vector version nil summary))
210 package--builtins))
211 ((eq base-name package)
212 (setq desc (cdr entry))
213 (aset desc 0 version)
214 (aset desc 2 summary)))
215 (dolist (kw keywords)
216 (puthash kw
217 (cons package
218 (delq package
219 (gethash kw finder-keywords-hash)))
220 finder-keywords-hash))))))))
222 (setq package--builtins
223 (sort package--builtins
224 (lambda (a b) (string< (symbol-name (car a))
225 (symbol-name (car b))))))
227 (save-excursion
228 (find-file generated-finder-keywords-file)
229 (setq buffer-undo-list t)
230 (erase-buffer)
231 (insert (autoload-rubric generated-finder-keywords-file
232 "keyword-to-package mapping" t))
233 (search-backward "\f")
234 (insert "(setq package--builtins '(\n")
235 (dolist (package package--builtins)
236 (insert " ")
237 (prin1 package (current-buffer))
238 (insert "\n"))
239 (insert "))\n\n")
240 ;; Insert hash table.
241 (insert "(setq finder-keywords-hash\n ")
242 (prin1 finder-keywords-hash (current-buffer))
243 (insert ")\n")
244 (basic-save-buffer)))
246 (defun finder-compile-keywords-make-dist ()
247 "Regenerate `finder-inf.el' for the Emacs distribution."
248 (apply 'finder-compile-keywords command-line-args-left)
249 (kill-emacs))
251 ;;; Now the retrieval code
253 (defun finder-insert-at-column (column &rest strings)
254 "Insert, at column COLUMN, other args STRINGS."
255 (if (>= (current-column) column) (insert "\n"))
256 (move-to-column column t)
257 (apply 'insert strings))
259 (defvar finder-help-echo nil)
261 (defun finder-mouse-face-on-line ()
262 "Put `mouse-face' and `help-echo' properties on the previous line."
263 (save-excursion
264 (forward-line -1)
265 ;; If finder-insert-at-column moved us to a new line, go back one more.
266 (if (looking-at "[ \t]") (forward-line -1))
267 (unless finder-help-echo
268 (setq finder-help-echo
269 (let* ((keys1 (where-is-internal 'finder-select
270 finder-mode-map))
271 (keys (nconc (where-is-internal
272 'finder-mouse-select finder-mode-map)
273 keys1)))
274 (concat (mapconcat 'key-description keys ", ")
275 ": select item"))))
276 (add-text-properties
277 (line-beginning-position) (line-end-position)
278 '(mouse-face highlight
279 help-echo finder-help-echo))))
281 (defun finder-unknown-keywords ()
282 "Return an alist of unknown keywords and number of their occurrences.
283 Unknown keywords are those present in `finder-keywords-hash' but
284 not `finder-known-keywords'."
285 (let (alist)
286 (maphash (lambda (kw packages)
287 (unless (assq kw finder-known-keywords)
288 (push (cons kw (length packages)) alist)))
289 finder-keywords-hash)
290 (sort alist (lambda (a b) (string< (car a) (car b))))))
292 ;;;###autoload
293 (defun finder-list-keywords ()
294 "Display descriptions of the keywords in the Finder buffer."
295 (interactive)
296 (if (get-buffer "*Finder*")
297 (pop-to-buffer "*Finder*")
298 (pop-to-buffer (get-buffer-create "*Finder*"))
299 (finder-mode)
300 (let ((inhibit-read-only t))
301 (erase-buffer)
302 (dolist (assoc finder-known-keywords)
303 (let ((keyword (car assoc)))
304 (insert (propertize (symbol-name keyword)
305 'font-lock-face 'font-lock-constant-face))
306 (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
307 (finder-mouse-face-on-line)))
308 (goto-char (point-min))
309 (setq finder-headmark (point)
310 buffer-read-only t)
311 (set-buffer-modified-p nil)
312 (balance-windows)
313 (finder-summary))))
315 (defun finder-list-matches (key)
316 (let* ((id (intern key))
317 (packages (gethash id finder-keywords-hash)))
318 (unless packages
319 (error "No packages matching key `%s'" key))
320 (package-show-package-list packages)))
322 (define-button-type 'finder-xref 'action #'finder-goto-xref)
324 (defun finder-goto-xref (button)
325 "Jump to a lisp file for the BUTTON at point."
326 (let* ((file (button-get button 'xref))
327 (lib (locate-library file)))
328 (if lib (finder-commentary lib)
329 (message "Unable to locate `%s'" file))))
331 ;;;###autoload
332 (defun finder-commentary (file)
333 "Display FILE's commentary section.
334 FILE should be in a form suitable for passing to `locate-library'."
335 (interactive
336 (list
337 (completing-read "Library name: "
338 (apply-partially 'locate-file-completion-table
339 (or find-function-source-path load-path)
340 (find-library-suffixes)))))
341 (let ((str (lm-commentary (find-library-name file))))
342 (or str (error "Can't find any Commentary section"))
343 ;; This used to use *Finder* but that would clobber the
344 ;; directory of categories.
345 (pop-to-buffer "*Finder-package*")
346 (setq buffer-read-only nil
347 buffer-undo-list t)
348 (erase-buffer)
349 (insert str)
350 (goto-char (point-min))
351 (delete-blank-lines)
352 (goto-char (point-max))
353 (delete-blank-lines)
354 (goto-char (point-min))
355 (while (re-search-forward "^;+ ?" nil t)
356 (replace-match "" nil nil))
357 (goto-char (point-min))
358 (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
359 (if (locate-library (match-string 1))
360 (make-text-button (match-beginning 1) (match-end 1)
361 'xref (match-string-no-properties 1)
362 'help-echo "Read this file's commentary"
363 :type 'finder-xref)))
364 (goto-char (point-min))
365 (setq buffer-read-only t)
366 (set-buffer-modified-p nil)
367 (shrink-window-if-larger-than-buffer)
368 (finder-mode)
369 (finder-summary)))
371 (defun finder-current-item ()
372 (let ((key (save-excursion
373 (beginning-of-line)
374 (current-word))))
375 (if (or (and finder-headmark (< (point) finder-headmark))
376 (zerop (length key)))
377 (error "No keyword or filename on this line")
378 key)))
380 (defun finder-select ()
381 "Select item on current line in a finder buffer."
382 (interactive)
383 (let ((key (finder-current-item)))
384 (if (string-match "\\.el$" key)
385 (finder-commentary key)
386 (finder-list-matches key))))
388 (defun finder-mouse-select (event)
389 "Select item in a finder buffer with the mouse."
390 (interactive "e")
391 (with-current-buffer (window-buffer (posn-window (event-start event)))
392 (goto-char (posn-point (event-start event)))
393 (finder-select)))
395 ;;;###autoload
396 (defun finder-by-keyword ()
397 "Find packages matching a given keyword."
398 (interactive)
399 (finder-list-keywords))
401 (define-derived-mode finder-mode nil "Finder"
402 "Major mode for browsing package documentation.
403 \\<finder-mode-map>
404 \\[finder-select] more help for the item on the current line
405 \\[finder-exit] exit Finder mode and kill the Finder buffer."
406 :syntax-table finder-mode-syntax-table
407 (setq buffer-read-only t
408 buffer-undo-list t)
409 (set (make-local-variable 'finder-headmark) nil))
411 (defun finder-summary ()
412 "Summarize basic Finder commands."
413 (interactive)
414 (message "%s"
415 (substitute-command-keys
416 "\\<finder-mode-map>\\[finder-select] = select, \
417 \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
418 finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
420 (defun finder-exit ()
421 "Exit Finder mode.
422 Delete the window and kill all Finder-related buffers."
423 (interactive)
424 (ignore-errors (delete-window))
425 (let ((buf "*Finder*"))
426 (and (get-buffer buf) (kill-buffer buf))))
429 (provide 'finder)
431 ;;; finder.el ends here