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

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

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

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Eric S. Raymond's avatar
Eric S. Raymond committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; 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
17 18 19 20 21 22 23

;; 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
24
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
Eric S. Raymond's avatar
Eric S. Raymond committed
25

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

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

;;; Code:

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

Dave Love's avatar
Dave Love committed
38 39
;; These are supposed to correspond to top-level customization groups,
;; says rms.
Eric S. Raymond's avatar
Eric S. Raymond committed
40
(defvar finder-known-keywords
41 42 43 44 45
  '((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")
46
    (convenience . "convenience features for faster editing")
47 48
    (data	. "editing data (non-text) files")
    (docs	. "Emacs documentation facilities")
Eric S. Raymond's avatar
Eric S. Raymond committed
49 50
    (emulations	. "emulations of other editors")
    (extensions	. "Emacs Lisp language extensions")
51 52 53
    (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
54
    (games	. "games, jokes and amusements")
55
    (hardware	. "interfacing with system hardware")
56
    (help	. "Emacs help systems")
57 58
    (hypermedia . "links between text or other media types")
    (i18n	. "internationalization and character-set support")
Eric S. Raymond's avatar
Eric S. Raymond committed
59 60 61 62
    (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")
63 64 65
    (maint	. "Emacs development tools and aids")
    (mail	. "email reading and posting")
    (matching	. "searching, matching, and sorting")
66
    (mouse	. "mouse support")
67 68 69 70 71 72
    (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
73
    (tools	. "programming tools")
74
    (unix	. "UNIX feature interfaces and emulators")
75
    (vc		. "version control")
76 77 78
    (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
79

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

    (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"))
108
    map)
109
  "Keymap used in `finder-mode'.")
110

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

117
(defvar finder-headmark nil
Juanma Barranquero's avatar
Juanma Barranquero committed
118
  "Internal Finder mode variable, local in Finder buffer.")
119

Eric S. Raymond's avatar
Eric S. Raymond committed
120 121
;;; Code for regenerating the keyword list.

122 123 124
(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
125

126
(defvar generated-finder-keywords-file "finder-inf.el"
127 128 129 130 131
  "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.
132
;; https://lists.gnu.org/r/emacs-pretest-bug/2007-01/msg00469.html
133 134
;; ldefs-boot is not auto-generated, but has nothing useful.
(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
135
cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
136 137 138
  "Regexp matching file names not to scan for keywords.")

(autoload 'autoload-rubric "autoload")
139

140 141 142 143 144 145 146 147 148 149 150
(defconst finder--builtins-descriptions
  ;; I have no idea whether these are supposed to be capitalized
  ;; and/or end in a full-stop.  Existing file headers are inconsistent,
  ;; but mainly seem to not do so.
  '((emacs . "the extensible text editor")
    (nxml . "a new XML mode"))
  "Alist of built-in package descriptions.
Entries have the form (PACKAGE-SYMBOL . DESCRIPTION).
When generating `package--builtins', this overrides what the description
would otherwise be.")

151 152 153 154 155 156 157 158 159 160 161 162 163 164 165
(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)
166 167 168 169
    ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el
    ;; is the main file for the package.  Then we would not need an
    ;; entry in finder--builtins-descriptions.  But I do not know if
    ;; it is safe to change this, in case it is already in use.
170 171 172 173 174 175 176 177 178 179 180
    ("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
181
(defun finder-compile-keywords (&rest dirs)
182 183 184 185 186 187 188 189 190
  "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))
191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
  (let* ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
         (file-count 0)
         (files (cl-loop for d in (or dirs load-path)
                         when (file-exists-p (directory-file-name d))
                         append (mapcar
                                 (lambda (f)
                                   (cons d f))
                                 (directory-files d nil el-file-regexp))))
         (progress (make-progress-reporter
                    (byte-compile-info-string "Scanning files for finder")
                    0 (length files)))
	 package-override base-name ; processed
	 summary keywords package version entry desc)
    (dolist (elem files)
      (let* ((d (car elem))
             (f (cdr elem))
             (package-override
208 209
	      (intern-soft
	       (cdr-safe
210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
	        (assoc (file-name-nondirectory
                        (directory-file-name d))
		       finder--builtins-alist)))))
        (progress-reporter-update progress (setq file-count (1+ file-count)))
        (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))
          ;; 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.
          ;; https://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 if package-override is nil?
          ;;	    (push base-name processed)
	  (with-temp-buffer
	    (insert-file-contents (expand-file-name f d))
	    (setq keywords (mapcar 'intern (lm-keywords-list))
		  package  (or package-override
			       (let ((str (lm-header "package")))
			         (if str (intern str)))
			       base-name)
		  summary  (or (cdr
			        (assq package finder--builtins-descriptions))
			       (lm-synopsis))
		  version  (lm-header "version")))
	  (when summary
243 244
	    (setq version (or (ignore-errors (version-to-list version))
                              (alist-get package package--builtin-versions)))
245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263
	    (setq entry (assq package package--builtins))
	    (cond ((null entry)
		   (push (cons package
                               (package-make-builtin version summary))
		         package--builtins))
		  ;; The idea here is that eg calc.el gets to define
		  ;; the description of the calc package.
		  ;; This does not work for eg nxml-mode.el.
		  ((or (eq base-name package) version)
		   (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))))))
    (progress-reporter-done progress))
264 265 266 267 268
  (setq package--builtins
	(sort package--builtins
	      (lambda (a b) (string< (symbol-name (car a))
				     (symbol-name (car b))))))

269 270
  (with-current-buffer
      (find-file-noselect generated-finder-keywords-file)
271 272 273
    (setq buffer-undo-list t)
    (erase-buffer)
    (insert (autoload-rubric generated-finder-keywords-file
274
                             "keyword-to-package mapping" t))
275
    (search-backward "")
276 277 278
    ;; 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.
279 280
    (insert "(setq package--builtins '(\n")
    (dolist (package package--builtins)
281 282 283 284
      (insert "  ")
      (prin1 package (current-buffer))
      (insert "\n"))
    (insert "))\n\n")
285 286 287 288
    ;; Insert hash table.
    (insert "(setq finder-keywords-hash\n      ")
    (prin1 finder-keywords-hash (current-buffer))
    (insert ")\n")
289
    (basic-save-buffer)))
Eric S. Raymond's avatar
Eric S. Raymond committed
290

291 292
(defun finder-compile-keywords-make-dist ()
  "Regenerate `finder-inf.el' for the Emacs distribution."
293 294
  (apply 'finder-compile-keywords command-line-args-left)
  (kill-emacs))
295

Eric S. Raymond's avatar
Eric S. Raymond committed
296 297
;;; Now the retrieval code

Erik Naggum's avatar
Erik Naggum committed
298
(defun finder-insert-at-column (column &rest strings)
299
  "Insert, at column COLUMN, other args STRINGS."
300
  (if (>= (current-column) column) (insert "\n"))
301
  (move-to-column column t)
Erik Naggum's avatar
Erik Naggum committed
302 303
  (apply 'insert strings))

304 305
(defvar finder-help-echo nil)

306
(defun finder-mouse-face-on-line ()
307
  "Put `mouse-face' and `help-echo' properties on the previous line."
308
  (save-excursion
309
    (forward-line -1)
310 311
    ;; If finder-insert-at-column moved us to a new line, go back one more.
    (if (looking-at "[ \t]") (forward-line -1))
312 313 314 315 316 317 318 319 320 321 322 323 324
    (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))))
325

Juri Linkov's avatar
Juri Linkov committed
326
(defun finder-unknown-keywords ()
Juanma Barranquero's avatar
Juanma Barranquero committed
327
  "Return an alist of unknown keywords and number of their occurrences.
328 329 330 331 332 333 334 335
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
336

337
;;;###autoload
338 339 340
(defun finder-list-keywords ()
  "Display descriptions of the keywords in the Finder buffer."
  (interactive)
341 342
  (if (get-buffer "*Finder*")
      (pop-to-buffer "*Finder*")
343
    (pop-to-buffer (get-buffer-create "*Finder*"))
344
    (finder-mode)
345 346 347 348 349 350 351 352 353 354 355 356 357 358
    (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))))
359 360

(defun finder-list-matches (key)
361 362 363 364
  (let* ((id (intern key))
	 (packages (gethash id finder-keywords-hash)))
    (unless packages
      (error "No packages matching key `%s'" key))
365 366
    (let ((package-list-unversioned t))
      (package-show-package-list packages))))
367

368 369 370 371 372 373 374 375 376
(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))))

377
;;;###autoload
378
(defun finder-commentary (file)
379 380
  "Display FILE's commentary section.
FILE should be in a form suitable for passing to `locate-library'."
381 382 383
  (interactive
   (list
    (completing-read "Library name: "
384 385 386
		     (apply-partially 'locate-file-completion-table
                                      (or find-function-source-path load-path)
                                      (find-library-suffixes)))))
387 388
  (let ((str (lm-commentary (find-library-name file))))
    (or str (error "Can't find any Commentary section"))
389 390 391
    ;; This used to use *Finder* but that would clobber the
    ;; directory of categories.
    (pop-to-buffer "*Finder-package*")
392 393
    (setq buffer-read-only nil
          buffer-undo-list t)
394 395 396 397 398 399 400 401 402 403
    (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))
404 405 406 407
    (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)
408
                            'help-echo "Read this file's commentary"
409 410
                            :type 'finder-xref)))
    (goto-char (point-min))
411 412 413
    (setq buffer-read-only t)
    (set-buffer-modified-p nil)
    (shrink-window-if-larger-than-buffer)
414
    (finder-mode)
Erik Naggum's avatar
Erik Naggum committed
415
    (finder-summary)))
416 417

(defun finder-current-item ()
418 419 420 421
  (let ((key (save-excursion
	       (beginning-of-line)
	       (current-word))))
    (if (or (and finder-headmark (< (point) finder-headmark))
422
	    (zerop (length key)))
423 424
	(error "No keyword or filename on this line")
      key)))
425 426

(defun finder-select ()
Juanma Barranquero's avatar
Juanma Barranquero committed
427
  "Select item on current line in a Finder buffer."
428 429
  (interactive)
  (let ((key (finder-current-item)))
430 431 432 433 434
      (if (string-match "\\.el$" key)
	  (finder-commentary key)
	(finder-list-matches key))))

(defun finder-mouse-select (event)
Juanma Barranquero's avatar
Juanma Barranquero committed
435
  "Select item in a Finder buffer with the mouse."
436
  (interactive "e")
437
  (with-current-buffer (window-buffer (posn-window (event-start event)))
438 439
    (goto-char (posn-point (event-start event)))
    (finder-select)))
440

441
;;;###autoload
Eric S. Raymond's avatar
Eric S. Raymond committed
442 443 444
(defun finder-by-keyword ()
  "Find packages matching a given keyword."
  (interactive)
445 446
  (finder-list-keywords))

447
(define-derived-mode finder-mode nil "Finder"
448
  "Major mode for browsing package documentation.
449
\\<finder-mode-map>
450
\\[finder-select]	more help for the item on the current line
451
\\[finder-exit]	exit Finder mode and kill the Finder buffer."
452
  :syntax-table finder-mode-syntax-table
453 454
  (setq buffer-read-only t
	buffer-undo-list t)
455
  (set (make-local-variable 'finder-headmark) nil))
456 457 458 459

(defun finder-summary ()
  "Summarize basic Finder commands."
  (interactive)
460
  (message "%s"
461
   (substitute-command-keys
462 463 464
    "\\<finder-mode-map>\\[finder-select] = select, \
\\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
465

466
(defun finder-exit ()
467
  "Exit Finder mode.
468
Delete the window and kill all Finder-related buffers."
469
  (interactive)
470
  (ignore-errors (delete-window))
471 472
  (let ((buf "*Finder*"))
    (and (get-buffer buf) (kill-buffer buf))))
Eric S. Raymond's avatar
Eric S. Raymond committed
473

474 475 476 477 478 479
(defun finder-unload-function ()
  "Unload the Finder library."
  (with-demoted-errors (unload-feature 'finder-inf t))
  ;; continue standard unloading
  nil)

480

Eric S. Raymond's avatar
Eric S. Raymond committed
481 482 483
(provide 'finder)

;;; finder.el ends here