finder.el 16 KB
Newer Older
Eric S. Raymond's avatar
Eric S. Raymond committed
1 2
;;; finder.el --- topic & keyword-based code finder

3
;; Copyright (C) 1992, 1997-1999, 2001-2014 Free Software Foundation, Inc.
Eric S. Raymond's avatar
Eric S. Raymond committed
4 5 6 7 8 9 10 11

;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
;; Version: 1.0
;; Keywords: help

;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Eric S. Raymond's avatar
Eric S. Raymond committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Eric S. Raymond's avatar
Eric S. Raymond committed
16 17 18 19 20 21 22

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; 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/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
24

25
;;; Commentary:
Eric S. Raymond's avatar
Eric S. Raymond committed
26 27 28 29 30 31

;; This mode uses the Keywords library header to provide code-finding
;; services by keyword.

;;; Code:

32
(require 'package)
Eric S. Raymond's avatar
Eric S. Raymond committed
33
(require 'lisp-mnt)
34 35
(require 'find-func) ;for find-library(-suffixes)
(require 'finder-inf nil t)
Eric S. Raymond's avatar
Eric S. Raymond committed
36

Dave Love's avatar
Dave Love committed
37 38
;; These are supposed to correspond to top-level customization groups,
;; says rms.
Eric S. Raymond's avatar
Eric S. Raymond committed
39
(defvar finder-known-keywords
40 41 42 43 44
  '((abbrev	. "abbreviation handling, typing shortcuts, and macros")
    (bib	. "bibliography processors")
    (c		. "C and related programming languages")
    (calendar	. "calendar and time management tools")
    (comm	. "communications, networking, and remote file access")
45
    (convenience . "convenience features for faster editing")
46 47
    (data	. "editing data (non-text) files")
    (docs	. "Emacs documentation facilities")
Eric S. Raymond's avatar
Eric S. Raymond committed
48 49
    (emulations	. "emulations of other editors")
    (extensions	. "Emacs Lisp language extensions")
50 51 52
    (faces	. "fonts and colors for text")
    (files      . "file editing and manipulation")
    (frames     . "Emacs frames and window systems")
Eric S. Raymond's avatar
Eric S. Raymond committed
53
    (games	. "games, jokes and amusements")
54 55 56 57
    (hardware	. "interfacing with system hardware")
    (help	. "on-line help systems")
    (hypermedia . "links between text or other media types")
    (i18n	. "internationalization and character-set support")
Eric S. Raymond's avatar
Eric S. Raymond committed
58 59 60 61
    (internal	. "code for Emacs internals, build process, defaults")
    (languages	. "specialized modes for editing programming languages")
    (lisp	. "Lisp support, including Emacs Lisp")
    (local	. "code local to your site")
62 63 64
    (maint	. "Emacs development tools and aids")
    (mail	. "email reading and posting")
    (matching	. "searching, matching, and sorting")
65
    (mouse	. "mouse support")
66 67 68 69 70 71
    (multimedia . "images and sound")
    (news	. "USENET news reading and posting")
    (outlines   . "hierarchical outlining and note taking")
    (processes	. "processes, subshells, and compilation")
    (terminals	. "text terminals (ttys)")
    (tex	. "the TeX document formatter")
Eric S. Raymond's avatar
Eric S. Raymond committed
72
    (tools	. "programming tools")
73
    (unix	. "UNIX feature interfaces and emulators")
74
    (vc		. "version control")
75 76 77
    (wp		. "word processing"))
  "Association list of the standard \"Keywords:\" headers.
Each element has the form (KEYWORD . DESCRIPTION).")
Eric S. Raymond's avatar
Eric S. Raymond committed
78

79
(defvar finder-mode-map
80 81
  (let ((map (make-sparse-keymap))
	(menu-map (make-sparse-keymap "Finder")))
82 83
    (define-key map " "	'finder-select)
    (define-key map "f"	'finder-select)
84
    (define-key map [follow-link] 'mouse-face)
85 86 87
    (define-key map [mouse-2]	'finder-mouse-select)
    (define-key map "\C-m"	'finder-select)
    (define-key map "?"	'finder-summary)
88 89
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
90 91
    (define-key map "q"	'finder-exit)
    (define-key map "d"	'finder-list-keywords)
92 93 94 95 96 97 98 99 100 101 102 103 104 105 106

    (define-key map [menu-bar finder-mode]
      (cons "Finder" menu-map))
    (define-key menu-map [finder-exit]
      '(menu-item "Quit" finder-exit
		  :help "Exit Finder mode"))
    (define-key menu-map [finder-summary]
      '(menu-item "Summary" finder-summary
		  :help "Summary item on current line in a finder buffer"))
    (define-key menu-map [finder-list-keywords]
      '(menu-item "List keywords" finder-list-keywords
		  :help "Display descriptions of the keywords in the Finder buffer"))
    (define-key menu-map [finder-select]
      '(menu-item "Select" finder-select
		  :help "Select item on current line in a finder buffer"))
107
    map)
108
  "Keymap used in `finder-mode'.")
109

110 111 112 113
(defvar finder-mode-syntax-table
  (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
    (modify-syntax-entry ?\; ".   " st)
    st)
114
  "Syntax table used while in `finder-mode'.")
115 116

(defvar finder-font-lock-keywords
117
  '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
118 119
  "Font-lock keywords for Finder mode.")

120
(defvar finder-headmark nil
Juanma Barranquero's avatar
Juanma Barranquero committed
121
  "Internal Finder mode variable, local in Finder buffer.")
122

Eric S. Raymond's avatar
Eric S. Raymond committed
123 124
;;; Code for regenerating the keyword list.

125 126 127
(defvar finder-keywords-hash nil
  "Hash table mapping keywords to lists of package names.
Keywords and package names both should be symbols.")
Eric S. Raymond's avatar
Eric S. Raymond committed
128

129
(defvar generated-finder-keywords-file "finder-inf.el"
130 131 132 133 134 135
  "The function `finder-compile-keywords' writes keywords into this file.")

;; Skip autogenerated files, because they will never contain anything
;; useful, and because in parallel builds of Emacs they may get
;; modified while we are trying to read them.
;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
136 137
;; ldefs-boot is not auto-generated, but has nothing useful.
(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
138
cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
139 140 141
  "Regexp matching file names not to scan for keywords.")

(autoload 'autoload-rubric "autoload")
142

143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168
(defvar finder--builtins-alist
  '(("calc" . calc)
    ("ede"  . ede)
    ("erc"  . erc)
    ("eshell" . eshell)
    ("gnus" . gnus)
    ("international" . emacs)
    ("language" . emacs)
    ("mh-e" . mh-e)
    ("semantic" . semantic)
    ("analyze" . semantic)
    ("bovine" . semantic)
    ("decorate" . semantic)
    ("symref" . semantic)
    ("wisent" . semantic)
    ("nxml" . nxml)
    ("org"  . org)
    ("srecode" . srecode)
    ("term" . emacs)
    ("url"  . url))
  "Alist of built-in package directories.
Each element should have the form (DIR . PACKAGE), where DIR is a
directory name and PACKAGE is the name of a package (a symbol).
When generating `package--builtins', Emacs assumes any file in
DIR is part of the package PACKAGE.")

Eric S. Raymond's avatar
Eric S. Raymond committed
169
(defun finder-compile-keywords (&rest dirs)
170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196
  "Regenerate list of built-in Emacs packages.
This recomputes `package--builtins' and `finder-keywords-hash',
and prints them into the file `generated-finder-keywords-file'.

Optional DIRS is a list of Emacs Lisp directories to compile
from; the default is `load-path'."
  ;; Allow compressed files also.
  (setq package--builtins nil)
  (setq finder-keywords-hash (make-hash-table :test 'eq))
  (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
	package-override files base-name processed
	summary keywords package version entry desc)
    (dolist (d (or dirs load-path))
      (when (file-exists-p (directory-file-name d))
	(message "Directory %s" d)
	(setq package-override
	      (intern-soft
	       (cdr-safe
		(assoc (file-name-nondirectory (directory-file-name d))
		       finder--builtins-alist))))
	(setq files (directory-files d nil el-file-regexp))
	(dolist (f files)
	  (unless (or (string-match finder-no-scan-regexp f)
		      (null (setq base-name
				  (and (string-match el-file-regexp f)
				       (intern (match-string 1 f)))))
		      (memq base-name processed))
197 198 199 200 201 202 203 204 205 206
;; There are multiple files in the tree with the same basename.
;; So skipping files based on basename means you randomly (depending
;; on which order the files are traversed in) miss some packages.
;; http://debbugs.gnu.org/14010
;; You might think this could lead to two files providing the same package,
;; but it does not, because the duplicates are (at time of writing)
;; all due to files in cedet, which end up with package-override set.
;; FIXME this is obviously fragile.
;; Make the (eq base-name package) case below issue a warning?
;;	    (push base-name processed)
207 208 209 210 211
	    (with-temp-buffer
	      (insert-file-contents (expand-file-name f d))
	      (setq summary  (lm-synopsis)
		    keywords (mapcar 'intern (lm-keywords-list))
		    package  (or package-override
212 213
				 (let ((str (lm-header "package")))
				   (if str (intern str)))
214 215 216 217 218 219
				 base-name)
		    version  (lm-header "version")))
	    (when summary
	      (setq version (ignore-errors (version-to-list version)))
	      (setq entry (assq package package--builtins))
	      (cond ((null entry)
220 221
		     (push (cons package
                                 (package-make-builtin version summary))
222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238
			   package--builtins))
		    ((eq base-name package)
		     (setq desc (cdr entry))
		     (aset desc 0 version)
		     (aset desc 2 summary)))
	      (dolist (kw keywords)
		(puthash kw
			 (cons package
			       (delq package
				     (gethash kw finder-keywords-hash)))
			 finder-keywords-hash))))))))

  (setq package--builtins
	(sort package--builtins
	      (lambda (a b) (string< (symbol-name (car a))
				     (symbol-name (car b))))))

239 240
  (with-current-buffer
      (find-file-noselect generated-finder-keywords-file)
241 242 243
    (setq buffer-undo-list t)
    (erase-buffer)
    (insert (autoload-rubric generated-finder-keywords-file
244
                             "keyword-to-package mapping" t))
245
    (search-backward "")
246 247 248
    ;; FIXME: Now that we have package--builtin-versions, package--builtins is
    ;; only needed to get the list of unversioned packages and to get the
    ;; summary description of each package.
249 250
    (insert "(setq package--builtins '(\n")
    (dolist (package package--builtins)
251 252 253 254
      (insert "  ")
      (prin1 package (current-buffer))
      (insert "\n"))
    (insert "))\n\n")
255 256 257 258
    ;; Insert hash table.
    (insert "(setq finder-keywords-hash\n      ")
    (prin1 finder-keywords-hash (current-buffer))
    (insert ")\n")
259
    (basic-save-buffer)))
Eric S. Raymond's avatar
Eric S. Raymond committed
260

261 262
(defun finder-compile-keywords-make-dist ()
  "Regenerate `finder-inf.el' for the Emacs distribution."
263 264
  (apply 'finder-compile-keywords command-line-args-left)
  (kill-emacs))
265

Eric S. Raymond's avatar
Eric S. Raymond committed
266 267
;;; Now the retrieval code

Erik Naggum's avatar
Erik Naggum committed
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)
Erik Naggum's avatar
Erik Naggum committed
272 273
  (apply 'insert strings))

274 275
(defvar finder-help-echo nil)

276
(defun finder-mouse-face-on-line ()
277
  "Put `mouse-face' and `help-echo' properties on the previous line."
278
  (save-excursion
279
    (forward-line -1)
280 281
    ;; If finder-insert-at-column moved us to a new line, go back one more.
    (if (looking-at "[ \t]") (forward-line -1))
282 283 284 285 286 287 288 289 290 291 292 293 294
    (unless finder-help-echo
      (setq finder-help-echo
	    (let* ((keys1 (where-is-internal 'finder-select
					     finder-mode-map))
		   (keys (nconc (where-is-internal
				 'finder-mouse-select finder-mode-map)
				keys1)))
	      (concat (mapconcat 'key-description keys ", ")
		      ": select item"))))
    (add-text-properties
     (line-beginning-position) (line-end-position)
     '(mouse-face highlight
		  help-echo finder-help-echo))))
295

Juri Linkov's avatar
Juri Linkov committed
296
(defun finder-unknown-keywords ()
Juanma Barranquero's avatar
Juanma Barranquero committed
297
  "Return an alist of unknown keywords and number of their occurrences.
298 299 300 301 302 303 304 305
Unknown keywords are those present in `finder-keywords-hash' but
not `finder-known-keywords'."
  (let (alist)
    (maphash (lambda (kw packages)
	       (unless (assq kw finder-known-keywords)
		 (push (cons kw (length packages)) alist)))
	     finder-keywords-hash)
    (sort alist (lambda (a b) (string< (car a) (car b))))))
Juri Linkov's avatar
Juri Linkov committed
306

307
;;;###autoload
308 309 310
(defun finder-list-keywords ()
  "Display descriptions of the keywords in the Finder buffer."
  (interactive)
311 312
  (if (get-buffer "*Finder*")
      (pop-to-buffer "*Finder*")
313
    (pop-to-buffer (get-buffer-create "*Finder*"))
314
    (finder-mode)
315 316 317 318 319 320 321 322 323 324 325 326 327 328
    (let ((inhibit-read-only t))
      (erase-buffer)
      (dolist (assoc finder-known-keywords)
	(let ((keyword (car assoc)))
	  (insert (propertize (symbol-name keyword)
			      'font-lock-face 'font-lock-constant-face))
	  (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
	  (finder-mouse-face-on-line)))
      (goto-char (point-min))
      (setq finder-headmark (point)
	    buffer-read-only t)
      (set-buffer-modified-p nil)
      (balance-windows)
      (finder-summary))))
329 330

(defun finder-list-matches (key)
331 332 333 334
  (let* ((id (intern key))
	 (packages (gethash id finder-keywords-hash)))
    (unless packages
      (error "No packages matching key `%s'" key))
335
    (package-show-package-list packages)))
336

337 338 339 340 341 342 343 344 345
(define-button-type 'finder-xref 'action #'finder-goto-xref)

(defun finder-goto-xref (button)
  "Jump to a lisp file for the BUTTON at point."
  (let* ((file (button-get button 'xref))
         (lib (locate-library file)))
    (if lib (finder-commentary lib)
      (message "Unable to locate `%s'" file))))

346
;;;###autoload
347
(defun finder-commentary (file)
348 349
  "Display FILE's commentary section.
FILE should be in a form suitable for passing to `locate-library'."
350 351 352
  (interactive
   (list
    (completing-read "Library name: "
353 354 355
		     (apply-partially 'locate-file-completion-table
                                      (or find-function-source-path load-path)
                                      (find-library-suffixes)))))
356 357
  (let ((str (lm-commentary (find-library-name file))))
    (or str (error "Can't find any Commentary section"))
358 359 360
    ;; This used to use *Finder* but that would clobber the
    ;; directory of categories.
    (pop-to-buffer "*Finder-package*")
361 362
    (setq buffer-read-only nil
          buffer-undo-list t)
363 364 365 366 367 368 369 370 371 372
    (erase-buffer)
    (insert str)
    (goto-char (point-min))
    (delete-blank-lines)
    (goto-char (point-max))
    (delete-blank-lines)
    (goto-char (point-min))
    (while (re-search-forward "^;+ ?" nil t)
      (replace-match "" nil nil))
    (goto-char (point-min))
373 374 375 376 377 378 379
    (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
      (if (locate-library (match-string 1))
          (make-text-button (match-beginning 1) (match-end 1)
                            'xref (match-string-no-properties 1)
                            'help-echo "Read this file's commentary"
                            :type 'finder-xref)))
    (goto-char (point-min))
380 381 382
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)
    (shrink-window-if-larger-than-buffer)
383
    (finder-mode)
Erik Naggum's avatar
Erik Naggum committed
384
    (finder-summary)))
385 386

(defun finder-current-item ()
387 388 389 390
  (let ((key (save-excursion
	       (beginning-of-line)
	       (current-word))))
    (if (or (and finder-headmark (< (point) finder-headmark))
391
	    (zerop (length key)))
392 393
	(error "No keyword or filename on this line")
      key)))
394 395

(defun finder-select ()
Juanma Barranquero's avatar
Juanma Barranquero committed
396
  "Select item on current line in a Finder buffer."
397 398
  (interactive)
  (let ((key (finder-current-item)))
399 400 401 402 403
      (if (string-match "\\.el$" key)
	  (finder-commentary key)
	(finder-list-matches key))))

(defun finder-mouse-select (event)
Juanma Barranquero's avatar
Juanma Barranquero committed
404
  "Select item in a Finder buffer with the mouse."
405
  (interactive "e")
406
  (with-current-buffer (window-buffer (posn-window (event-start event)))
407 408
    (goto-char (posn-point (event-start event)))
    (finder-select)))
409

410
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
411 412 413
(defun finder-by-keyword ()
  "Find packages matching a given keyword."
  (interactive)
414 415
  (finder-list-keywords))

416
(define-derived-mode finder-mode nil "Finder"
417
  "Major mode for browsing package documentation.
418
\\<finder-mode-map>
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 423
  (setq buffer-read-only t
	buffer-undo-list t)
424
  (set (make-local-variable 'finder-headmark) nil))
425 426 427 428

(defun finder-summary ()
  "Summarize basic Finder commands."
  (interactive)
429
  (message "%s"
430
   (substitute-command-keys
431 432 433
    "\\<finder-mode-map>\\[finder-select] = select, \
\\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
434

435
(defun finder-exit ()
436
  "Exit Finder mode.
437
Delete the window and kill all Finder-related buffers."
438
  (interactive)
439
  (ignore-errors (delete-window))
440 441
  (let ((buf "*Finder*"))
    (and (get-buffer buf) (kill-buffer buf))))
Eric S. Raymond's avatar
Eric S. Raymond committed
442

443 444 445 446 447 448
(defun finder-unload-function ()
  "Unload the Finder library."
  (with-demoted-errors (unload-feature 'finder-inf t))
  ;; continue standard unloading
  nil)

449

Eric S. Raymond's avatar
Eric S. Raymond committed
450 451 452
(provide 'finder)

;;; finder.el ends here