solar.el fixes.
[emacs.git] / lisp / finder.el
blob784de0a4d4cb7c22eccd4c0529308600ec34737c
1 ;;; finder.el --- topic & keyword-based code finder
3 ;; Copyright (C) 1992, 1997-1999, 2001-2011 Free Software Foundation, Inc.
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
6 ;; Created: 16 Jun 1992
7 ;; Version: 1.0
8 ;; Keywords: help
10 ;; This file is part of GNU Emacs.
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;; Commentary:
27 ;; This mode uses the Keywords library header to provide code-finding
28 ;; services by keyword.
30 ;;; Code:
32 (require 'package)
33 (require 'lisp-mnt)
34 (require 'find-func) ;for find-library(-suffixes)
35 (require 'finder-inf nil t)
37 ;; These are supposed to correspond to top-level customization groups,
38 ;; says rms.
39 (defvar finder-known-keywords
40 '((abbrev . "abbreviation handling, typing shortcuts, and macros")
41 (bib . "bibliography processors")
42 (c . "C and related programming languages")
43 (calendar . "calendar and time management tools")
44 (comm . "communications, networking, and remote file access")
45 (convenience . "convenience features for faster editing")
46 (data . "editing data (non-text) files")
47 (docs . "Emacs documentation facilities")
48 (emulations . "emulations of other editors")
49 (extensions . "Emacs Lisp language extensions")
50 (faces . "fonts and colors for text")
51 (files . "file editing and manipulation")
52 (frames . "Emacs frames and window systems")
53 (games . "games, jokes and amusements")
54 (hardware . "interfacing with system hardware")
55 (help . "on-line help systems")
56 (hypermedia . "links between text or other media types")
57 (i18n . "internationalization and character-set support")
58 (internal . "code for Emacs internals, build process, defaults")
59 (languages . "specialized modes for editing programming languages")
60 (lisp . "Lisp support, including Emacs Lisp")
61 (local . "code local to your site")
62 (maint . "Emacs development tools and aids")
63 (mail . "email reading and posting")
64 (matching . "searching, matching, and sorting")
65 (mouse . "mouse support")
66 (multimedia . "images and sound")
67 (news . "USENET news reading and posting")
68 (outlines . "hierarchical outlining and note taking")
69 (processes . "processes, subshells, and compilation")
70 (terminals . "text terminals (ttys)")
71 (tex . "the TeX document formatter")
72 (tools . "programming tools")
73 (unix . "UNIX feature interfaces and emulators")
74 (vc . "version control")
75 (wp . "word processing")))
77 (defvar finder-mode-map
78 (let ((map (make-sparse-keymap))
79 (menu-map (make-sparse-keymap "Finder")))
80 (define-key map " " 'finder-select)
81 (define-key map "f" 'finder-select)
82 (define-key map [follow-link] 'mouse-face)
83 (define-key map [mouse-2] 'finder-mouse-select)
84 (define-key map "\C-m" 'finder-select)
85 (define-key map "?" 'finder-summary)
86 (define-key map "n" 'next-line)
87 (define-key map "p" 'previous-line)
88 (define-key map "q" 'finder-exit)
89 (define-key map "d" 'finder-list-keywords)
91 (define-key map [menu-bar finder-mode]
92 (cons "Finder" menu-map))
93 (define-key menu-map [finder-exit]
94 '(menu-item "Quit" finder-exit
95 :help "Exit Finder mode"))
96 (define-key menu-map [finder-summary]
97 '(menu-item "Summary" finder-summary
98 :help "Summary item on current line in a finder buffer"))
99 (define-key menu-map [finder-list-keywords]
100 '(menu-item "List keywords" finder-list-keywords
101 :help "Display descriptions of the keywords in the Finder buffer"))
102 (define-key menu-map [finder-select]
103 '(menu-item "Select" finder-select
104 :help "Select item on current line in a finder buffer"))
105 map))
107 (defvar finder-mode-syntax-table
108 (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
109 (modify-syntax-entry ?\; ". " st)
111 "Syntax table used while in `finder-mode'.")
113 (defvar finder-font-lock-keywords
114 '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
115 "Font-lock keywords for 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\\)\\.el$\\)"
136 "Regexp matching file names not to scan for keywords.")
138 (autoload 'autoload-rubric "autoload")
140 (defvar finder--builtins-alist
141 '(("calc" . calc)
142 ("ede" . ede)
143 ("erc" . erc)
144 ("eshell" . eshell)
145 ("gnus" . gnus)
146 ("international" . emacs)
147 ("language" . emacs)
148 ("mh-e" . mh-e)
149 ("semantic" . semantic)
150 ("analyze" . semantic)
151 ("bovine" . semantic)
152 ("decorate" . semantic)
153 ("symref" . semantic)
154 ("wisent" . semantic)
155 ("nxml" . nxml)
156 ("org" . org)
157 ("srecode" . srecode)
158 ("term" . emacs)
159 ("url" . url))
160 "Alist of built-in package directories.
161 Each element should have the form (DIR . PACKAGE), where DIR is a
162 directory name and PACKAGE is the name of a package (a symbol).
163 When generating `package--builtins', Emacs assumes any file in
164 DIR is part of the package PACKAGE.")
166 (defun finder-compile-keywords (&rest dirs)
167 "Regenerate list of built-in Emacs packages.
168 This recomputes `package--builtins' and `finder-keywords-hash',
169 and prints them into the file `generated-finder-keywords-file'.
171 Optional DIRS is a list of Emacs Lisp directories to compile
172 from; the default is `load-path'."
173 ;; Allow compressed files also.
174 (setq package--builtins nil)
175 (setq finder-keywords-hash (make-hash-table :test 'eq))
176 (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
177 package-override files base-name processed
178 summary keywords package version entry desc)
179 (dolist (d (or dirs load-path))
180 (when (file-exists-p (directory-file-name d))
181 (message "Directory %s" d)
182 (setq package-override
183 (intern-soft
184 (cdr-safe
185 (assoc (file-name-nondirectory (directory-file-name d))
186 finder--builtins-alist))))
187 (setq files (directory-files d nil el-file-regexp))
188 (dolist (f files)
189 (unless (or (string-match finder-no-scan-regexp f)
190 (null (setq base-name
191 (and (string-match el-file-regexp f)
192 (intern (match-string 1 f)))))
193 (memq base-name processed))
194 (push base-name processed)
195 (with-temp-buffer
196 (insert-file-contents (expand-file-name f d))
197 (setq summary (lm-synopsis)
198 keywords (mapcar 'intern (lm-keywords-list))
199 package (or package-override
200 (let ((str (lm-header "package")))
201 (if str (intern str)))
202 base-name)
203 version (lm-header "version")))
204 (when summary
205 (setq version (ignore-errors (version-to-list version)))
206 (setq entry (assq package package--builtins))
207 (cond ((null entry)
208 (push (cons package (vector version nil summary))
209 package--builtins))
210 ((eq base-name package)
211 (setq desc (cdr entry))
212 (aset desc 0 version)
213 (aset desc 2 summary)))
214 (dolist (kw keywords)
215 (puthash kw
216 (cons package
217 (delq package
218 (gethash kw finder-keywords-hash)))
219 finder-keywords-hash))))))))
221 (setq package--builtins
222 (sort package--builtins
223 (lambda (a b) (string< (symbol-name (car a))
224 (symbol-name (car b))))))
226 (save-excursion
227 (find-file generated-finder-keywords-file)
228 (setq buffer-undo-list t)
229 (erase-buffer)
230 (insert (autoload-rubric generated-finder-keywords-file
231 "keyword-to-package mapping" t))
232 (search-backward "\f")
233 (insert "(setq package--builtins '(\n")
234 (dolist (package package--builtins)
235 (insert " ")
236 (prin1 package (current-buffer))
237 (insert "\n"))
238 (insert "))\n\n")
239 ;; Insert hash table.
240 (insert "(setq finder-keywords-hash\n ")
241 (prin1 finder-keywords-hash (current-buffer))
242 (insert ")\n")
243 (basic-save-buffer)))
245 (defun finder-compile-keywords-make-dist ()
246 "Regenerate `finder-inf.el' for the Emacs distribution."
247 (apply 'finder-compile-keywords command-line-args-left)
248 (kill-emacs))
250 ;;; Now the retrieval code
252 (defun finder-insert-at-column (column &rest strings)
253 "Insert, at column COLUMN, other args STRINGS."
254 (if (>= (current-column) column) (insert "\n"))
255 (move-to-column column t)
256 (apply 'insert strings))
258 (defvar finder-help-echo nil)
260 (defun finder-mouse-face-on-line ()
261 "Put `mouse-face' and `help-echo' properties on the previous line."
262 (save-excursion
263 (forward-line -1)
264 ;; If finder-insert-at-column moved us to a new line, go back one more.
265 (if (looking-at "[ \t]") (forward-line -1))
266 (unless finder-help-echo
267 (setq finder-help-echo
268 (let* ((keys1 (where-is-internal 'finder-select
269 finder-mode-map))
270 (keys (nconc (where-is-internal
271 'finder-mouse-select finder-mode-map)
272 keys1)))
273 (concat (mapconcat 'key-description keys ", ")
274 ": select item"))))
275 (add-text-properties
276 (line-beginning-position) (line-end-position)
277 '(mouse-face highlight
278 help-echo finder-help-echo))))
280 (defun finder-unknown-keywords ()
281 "Return an alist of unknown keywords and number of their occurrences.
282 Unknown keywords are those present in `finder-keywords-hash' but
283 not `finder-known-keywords'."
284 (let (alist)
285 (maphash (lambda (kw packages)
286 (unless (assq kw finder-known-keywords)
287 (push (cons kw (length packages)) alist)))
288 finder-keywords-hash)
289 (sort alist (lambda (a b) (string< (car a) (car b))))))
291 ;;;###autoload
292 (defun finder-list-keywords ()
293 "Display descriptions of the keywords in the Finder buffer."
294 (interactive)
295 (if (get-buffer "*Finder*")
296 (pop-to-buffer "*Finder*")
297 (pop-to-buffer (get-buffer-create "*Finder*"))
298 (finder-mode)
299 (let ((inhibit-read-only t))
300 (erase-buffer)
301 (dolist (assoc finder-known-keywords)
302 (let ((keyword (car assoc)))
303 (insert (propertize (symbol-name keyword)
304 'font-lock-face 'font-lock-constant-face))
305 (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
306 (finder-mouse-face-on-line)))
307 (goto-char (point-min))
308 (setq finder-headmark (point)
309 buffer-read-only t)
310 (set-buffer-modified-p nil)
311 (balance-windows)
312 (finder-summary))))
314 (defun finder-list-matches (key)
315 (let* ((id (intern key))
316 (packages (gethash id finder-keywords-hash)))
317 (unless packages
318 (error "No packages matching key `%s'" key))
319 (package--list-packages packages)))
321 (define-button-type 'finder-xref 'action #'finder-goto-xref)
323 (defun finder-goto-xref (button)
324 "Jump to a lisp file for the BUTTON at point."
325 (let* ((file (button-get button 'xref))
326 (lib (locate-library file)))
327 (if lib (finder-commentary lib)
328 (message "Unable to locate `%s'" file))))
330 ;;;###autoload
331 (defun finder-commentary (file)
332 "Display FILE's commentary section.
333 FILE should be in a form suitable for passing to `locate-library'."
334 (interactive
335 (list
336 (completing-read "Library name: "
337 (apply-partially 'locate-file-completion-table
338 (or find-function-source-path load-path)
339 (find-library-suffixes)))))
340 (let ((str (lm-commentary (find-library-name file))))
341 (or str (error "Can't find any Commentary section"))
342 ;; This used to use *Finder* but that would clobber the
343 ;; directory of categories.
344 (pop-to-buffer "*Finder-package*")
345 (setq buffer-read-only nil
346 buffer-undo-list t)
347 (erase-buffer)
348 (insert str)
349 (goto-char (point-min))
350 (delete-blank-lines)
351 (goto-char (point-max))
352 (delete-blank-lines)
353 (goto-char (point-min))
354 (while (re-search-forward "^;+ ?" nil t)
355 (replace-match "" nil nil))
356 (goto-char (point-min))
357 (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
358 (if (locate-library (match-string 1))
359 (make-text-button (match-beginning 1) (match-end 1)
360 'xref (match-string-no-properties 1)
361 'help-echo "Read this file's commentary"
362 :type 'finder-xref)))
363 (goto-char (point-min))
364 (setq buffer-read-only t)
365 (set-buffer-modified-p nil)
366 (shrink-window-if-larger-than-buffer)
367 (finder-mode)
368 (finder-summary)))
370 (defun finder-current-item ()
371 (let ((key (save-excursion
372 (beginning-of-line)
373 (current-word))))
374 (if (or (and finder-headmark (< (point) finder-headmark))
375 (zerop (length key)))
376 (error "No keyword or filename on this line")
377 key)))
379 (defun finder-select ()
380 "Select item on current line in a finder buffer."
381 (interactive)
382 (let ((key (finder-current-item)))
383 (if (string-match "\\.el$" key)
384 (finder-commentary key)
385 (finder-list-matches key))))
387 (defun finder-mouse-select (event)
388 "Select item in a finder buffer with the mouse."
389 (interactive "e")
390 (with-current-buffer (window-buffer (posn-window (event-start event)))
391 (goto-char (posn-point (event-start event)))
392 (finder-select)))
394 ;;;###autoload
395 (defun finder-by-keyword ()
396 "Find packages matching a given keyword."
397 (interactive)
398 (finder-list-keywords))
400 (define-derived-mode finder-mode nil "Finder"
401 "Major mode for browsing package documentation.
402 \\<finder-mode-map>
403 \\[finder-select] more help for the item on the current line
404 \\[finder-exit] exit Finder mode and kill the Finder buffer."
405 :syntax-table finder-mode-syntax-table
406 (setq buffer-read-only t
407 buffer-undo-list t)
408 (set (make-local-variable 'finder-headmark) nil))
410 (defun finder-summary ()
411 "Summarize basic Finder commands."
412 (interactive)
413 (message "%s"
414 (substitute-command-keys
415 "\\<finder-mode-map>\\[finder-select] = select, \
416 \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
417 finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
419 (defun finder-exit ()
420 "Exit Finder mode.
421 Delete the window and kill all Finder-related buffers."
422 (interactive)
423 (ignore-errors (delete-window))
424 (let ((buf "*Finder*"))
425 (and (get-buffer buf) (kill-buffer buf))))
428 (provide 'finder)
430 ;;; finder.el ends here