1 ;;; finder.el --- topic & keyword-based code finder
3 ;; Copyright (C) 1992, 1997-1999, 2001-2014 Free Software Foundation, Inc.
5 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
6 ;; Created: 16 Jun 1992
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/>.
27 ;; This mode uses the Keywords library header to provide code-finding
28 ;; services by keyword.
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,
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"))
76 "Association list of the standard \"Keywords:\" headers.
77 Each element has the form (KEYWORD . DESCRIPTION).")
79 (defvar finder-mode-map
80 (let ((map (make-sparse-keymap))
81 (menu-map (make-sparse-keymap "Finder")))
82 (define-key map
" " 'finder-select
)
83 (define-key map
"f" 'finder-select
)
84 (define-key map
[follow-link
] 'mouse-face
)
85 (define-key map
[mouse-2
] 'finder-mouse-select
)
86 (define-key map
"\C-m" 'finder-select
)
87 (define-key map
"?" 'finder-summary
)
88 (define-key map
"n" 'next-line
)
89 (define-key map
"p" 'previous-line
)
90 (define-key map
"q" 'finder-exit
)
91 (define-key map
"d" 'finder-list-keywords
)
93 (define-key map
[menu-bar finder-mode
]
94 (cons "Finder" menu-map
))
95 (define-key menu-map
[finder-exit
]
96 '(menu-item "Quit" finder-exit
97 :help
"Exit Finder mode"))
98 (define-key menu-map
[finder-summary
]
99 '(menu-item "Summary" finder-summary
100 :help
"Summary item on current line in a finder buffer"))
101 (define-key menu-map
[finder-list-keywords
]
102 '(menu-item "List keywords" finder-list-keywords
103 :help
"Display descriptions of the keywords in the Finder buffer"))
104 (define-key menu-map
[finder-select
]
105 '(menu-item "Select" finder-select
106 :help
"Select item on current line in a finder buffer"))
108 "Keymap used in `finder-mode'.")
110 (defvar finder-mode-syntax-table
111 (let ((st (make-syntax-table emacs-lisp-mode-syntax-table
)))
112 (modify-syntax-entry ?\
; ". " st)
114 "Syntax table used while in `finder-mode'.")
116 (defvar finder-font-lock-keywords
117 '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend
))
118 "Font-lock keywords for Finder mode.")
120 (defvar finder-headmark nil
121 "Internal Finder mode variable, local in Finder buffer.")
123 ;;; Code for regenerating the keyword list.
125 (defvar finder-keywords-hash nil
126 "Hash table mapping keywords to lists of package names.
127 Keywords and package names both should be symbols.")
129 (defvar generated-finder-keywords-file
"finder-inf.el"
130 "The function `finder-compile-keywords' writes keywords into this file.")
132 ;; Skip autogenerated files, because they will never contain anything
133 ;; useful, and because in parallel builds of Emacs they may get
134 ;; modified while we are trying to read them.
135 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
136 ;; ldefs-boot is not auto-generated, but has nothing useful.
137 (defvar finder-no-scan-regexp
"\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
138 cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
139 "Regexp matching file names not to scan for keywords.")
141 (autoload 'autoload-rubric
"autoload")
143 (defvar finder--builtins-alist
149 ("international" . emacs
)
152 ("semantic" . semantic
)
153 ("analyze" . semantic
)
154 ("bovine" . semantic
)
155 ("decorate" . semantic
)
156 ("symref" . semantic
)
157 ("wisent" . semantic
)
160 ("srecode" . srecode
)
163 "Alist of built-in package directories.
164 Each element should have the form (DIR . PACKAGE), where DIR is a
165 directory name and PACKAGE is the name of a package (a symbol).
166 When generating `package--builtins', Emacs assumes any file in
167 DIR is part of the package PACKAGE.")
169 (defun finder-compile-keywords (&rest dirs
)
170 "Regenerate list of built-in Emacs packages.
171 This recomputes `package--builtins' and `finder-keywords-hash',
172 and prints them into the file `generated-finder-keywords-file'.
174 Optional DIRS is a list of Emacs Lisp directories to compile
175 from; the default is `load-path'."
176 ;; Allow compressed files also.
177 (setq package--builtins nil
)
178 (setq finder-keywords-hash
(make-hash-table :test
'eq
))
179 (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
180 package-override files base-name processed
181 summary keywords package version entry desc
)
182 (dolist (d (or dirs load-path
))
183 (when (file-exists-p (directory-file-name d
))
184 (message "Directory %s" d
)
185 (setq package-override
188 (assoc (file-name-nondirectory (directory-file-name d
))
189 finder--builtins-alist
))))
190 (setq files
(directory-files d nil el-file-regexp
))
192 (unless (or (string-match finder-no-scan-regexp f
)
193 (null (setq base-name
194 (and (string-match el-file-regexp f
)
195 (intern (match-string 1 f
)))))
196 (memq base-name processed
))
197 ;; There are multiple files in the tree with the same basename.
198 ;; So skipping files based on basename means you randomly (depending
199 ;; on which order the files are traversed in) miss some packages.
200 ;; http://debbugs.gnu.org/14010
201 ;; You might think this could lead to two files providing the same package,
202 ;; but it does not, because the duplicates are (at time of writing)
203 ;; all due to files in cedet, which end up with package-override set.
204 ;; FIXME this is obviously fragile.
205 ;; Make the (eq base-name package) case below issue a warning?
206 ;; (push base-name processed)
208 (insert-file-contents (expand-file-name f d
))
209 (setq summary
(lm-synopsis)
210 keywords
(mapcar 'intern
(lm-keywords-list))
211 package
(or package-override
212 (let ((str (lm-header "package")))
213 (if str
(intern str
)))
215 version
(lm-header "version")))
217 (setq version
(ignore-errors (version-to-list version
)))
218 (setq entry
(assq package package--builtins
))
221 (package-make-builtin version summary
))
223 ((eq base-name package
)
224 (setq desc
(cdr entry
))
225 (aset desc
0 version
)
226 (aset desc
2 summary
)))
227 (dolist (kw keywords
)
231 (gethash kw finder-keywords-hash
)))
232 finder-keywords-hash
))))))))
234 (setq package--builtins
235 (sort package--builtins
236 (lambda (a b
) (string< (symbol-name (car a
))
237 (symbol-name (car b
))))))
240 (find-file-noselect generated-finder-keywords-file
)
241 (setq buffer-undo-list t
)
243 (insert (autoload-rubric generated-finder-keywords-file
244 "keyword-to-package mapping" t
))
245 (search-backward "\f")
246 ;; FIXME: Now that we have package--builtin-versions, package--builtins is
247 ;; only needed to get the list of unversioned packages and to get the
248 ;; summary description of each package.
249 (insert "(setq package--builtins '(\n")
250 (dolist (package package--builtins
)
252 (prin1 package
(current-buffer))
255 ;; Insert hash table.
256 (insert "(setq finder-keywords-hash\n ")
257 (prin1 finder-keywords-hash
(current-buffer))
259 (basic-save-buffer)))
261 (defun finder-compile-keywords-make-dist ()
262 "Regenerate `finder-inf.el' for the Emacs distribution."
263 (apply 'finder-compile-keywords command-line-args-left
)
266 ;;; Now the retrieval code
268 (defun finder-insert-at-column (column &rest strings
)
269 "Insert, at column COLUMN, other args STRINGS."
270 (if (>= (current-column) column
) (insert "\n"))
271 (move-to-column column t
)
272 (apply 'insert strings
))
274 (defvar finder-help-echo nil
)
276 (defun finder-mouse-face-on-line ()
277 "Put `mouse-face' and `help-echo' properties on the previous line."
280 ;; If finder-insert-at-column moved us to a new line, go back one more.
281 (if (looking-at "[ \t]") (forward-line -
1))
282 (unless finder-help-echo
283 (setq finder-help-echo
284 (let* ((keys1 (where-is-internal 'finder-select
286 (keys (nconc (where-is-internal
287 'finder-mouse-select finder-mode-map
)
289 (concat (mapconcat 'key-description keys
", ")
292 (line-beginning-position) (line-end-position)
293 '(mouse-face highlight
294 help-echo finder-help-echo
))))
296 (defun finder-unknown-keywords ()
297 "Return an alist of unknown keywords and number of their occurrences.
298 Unknown keywords are those present in `finder-keywords-hash' but
299 not `finder-known-keywords'."
301 (maphash (lambda (kw packages
)
302 (unless (assq kw finder-known-keywords
)
303 (push (cons kw
(length packages
)) alist
)))
304 finder-keywords-hash
)
305 (sort alist
(lambda (a b
) (string< (car a
) (car b
))))))
308 (defun finder-list-keywords ()
309 "Display descriptions of the keywords in the Finder buffer."
311 (if (get-buffer "*Finder*")
312 (pop-to-buffer "*Finder*")
313 (pop-to-buffer (get-buffer-create "*Finder*"))
315 (let ((inhibit-read-only t
))
317 (dolist (assoc finder-known-keywords
)
318 (let ((keyword (car assoc
)))
319 (insert (propertize (symbol-name keyword
)
320 'font-lock-face
'font-lock-constant-face
))
321 (finder-insert-at-column 14 (concat (cdr assoc
) "\n"))
322 (finder-mouse-face-on-line)))
323 (goto-char (point-min))
324 (setq finder-headmark
(point)
326 (set-buffer-modified-p nil
)
330 (defun finder-list-matches (key)
331 (let* ((id (intern key
))
332 (packages (gethash id finder-keywords-hash
)))
334 (error "No packages matching key `%s'" key
))
335 (package-show-package-list packages
)))
337 (define-button-type 'finder-xref
'action
#'finder-goto-xref
)
339 (defun finder-goto-xref (button)
340 "Jump to a lisp file for the BUTTON at point."
341 (let* ((file (button-get button
'xref
))
342 (lib (locate-library file
)))
343 (if lib
(finder-commentary lib
)
344 (message "Unable to locate `%s'" file
))))
347 (defun finder-commentary (file)
348 "Display FILE's commentary section.
349 FILE should be in a form suitable for passing to `locate-library'."
352 (completing-read "Library name: "
353 (apply-partially 'locate-file-completion-table
354 (or find-function-source-path load-path
)
355 (find-library-suffixes)))))
356 (let ((str (lm-commentary (find-library-name file
))))
357 (or str
(error "Can't find any Commentary section"))
358 ;; This used to use *Finder* but that would clobber the
359 ;; directory of categories.
360 (pop-to-buffer "*Finder-package*")
361 (setq buffer-read-only nil
365 (goto-char (point-min))
367 (goto-char (point-max))
369 (goto-char (point-min))
370 (while (re-search-forward "^;+ ?" nil t
)
371 (replace-match "" nil nil
))
372 (goto-char (point-min))
373 (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t
)
374 (if (locate-library (match-string 1))
375 (make-text-button (match-beginning 1) (match-end 1)
376 'xref
(match-string-no-properties 1)
377 'help-echo
"Read this file's commentary"
378 :type
'finder-xref
)))
379 (goto-char (point-min))
380 (setq buffer-read-only t
)
381 (set-buffer-modified-p nil
)
382 (shrink-window-if-larger-than-buffer)
386 (defun finder-current-item ()
387 (let ((key (save-excursion
390 (if (or (and finder-headmark
(< (point) finder-headmark
))
391 (zerop (length key
)))
392 (error "No keyword or filename on this line")
395 (defun finder-select ()
396 "Select item on current line in a Finder buffer."
398 (let ((key (finder-current-item)))
399 (if (string-match "\\.el$" key
)
400 (finder-commentary key
)
401 (finder-list-matches key
))))
403 (defun finder-mouse-select (event)
404 "Select item in a Finder buffer with the mouse."
406 (with-current-buffer (window-buffer (posn-window (event-start event
)))
407 (goto-char (posn-point (event-start event
)))
411 (defun finder-by-keyword ()
412 "Find packages matching a given keyword."
414 (finder-list-keywords))
416 (define-derived-mode finder-mode nil
"Finder"
417 "Major mode for browsing package documentation.
419 \\[finder-select] more help for the item on the current line
420 \\[finder-exit] exit Finder mode and kill the Finder buffer."
421 :syntax-table finder-mode-syntax-table
422 (setq buffer-read-only t
424 (set (make-local-variable 'finder-headmark
) nil
))
426 (defun finder-summary ()
427 "Summarize basic Finder commands."
430 (substitute-command-keys
431 "\\<finder-mode-map>\\[finder-select] = select, \
432 \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
433 finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
435 (defun finder-exit ()
437 Delete the window and kill all Finder-related buffers."
439 (ignore-errors (delete-window))
440 (let ((buf "*Finder*"))
441 (and (get-buffer buf
) (kill-buffer buf
))))
443 (defun finder-unload-function ()
444 "Unload the Finder library."
445 (with-demoted-errors (unload-feature 'finder-inf t
))
446 ;; continue standard unloading
452 ;;; finder.el ends here