| 1 | ;;; finder.el --- topic & keyword-based code finder |
| 2 | |
| 3 | ;; Copyright (C) 1992, 1997-1999, 2001-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> |
| 6 | ;; Created: 16 Jun 1992 |
| 7 | ;; Version: 1.0 |
| 8 | ;; Keywords: help |
| 9 | |
| 10 | ;; This file is part of GNU Emacs. |
| 11 | |
| 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. |
| 16 | |
| 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. |
| 21 | |
| 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/>. |
| 24 | |
| 25 | ;;; Commentary: |
| 26 | |
| 27 | ;; This mode uses the Keywords library header to provide code-finding |
| 28 | ;; services by keyword. |
| 29 | |
| 30 | ;;; Code: |
| 31 | |
| 32 | (require 'package) |
| 33 | (require 'lisp-mnt) |
| 34 | (require 'find-func) ;for find-library(-suffixes) |
| 35 | (require 'finder-inf nil t) |
| 36 | |
| 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")) |
| 76 | "Association list of the standard \"Keywords:\" headers. |
| 77 | Each element has the form (KEYWORD . DESCRIPTION).") |
| 78 | |
| 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) |
| 92 | |
| 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")) |
| 107 | map) |
| 108 | "Keymap used in `finder-mode'.") |
| 109 | |
| 110 | (defvar finder-mode-syntax-table |
| 111 | (let ((st (make-syntax-table emacs-lisp-mode-syntax-table))) |
| 112 | (modify-syntax-entry ?\; ". " st) |
| 113 | st) |
| 114 | "Syntax table used while in `finder-mode'.") |
| 115 | |
| 116 | (defvar finder-font-lock-keywords |
| 117 | '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend)) |
| 118 | "Font-lock keywords for Finder mode.") |
| 119 | |
| 120 | (defvar finder-headmark nil |
| 121 | "Internal Finder mode variable, local in Finder buffer.") |
| 122 | |
| 123 | ;;; Code for regenerating the keyword list. |
| 124 | |
| 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.") |
| 128 | |
| 129 | (defvar generated-finder-keywords-file "finder-inf.el" |
| 130 | "The function `finder-compile-keywords' writes keywords into this file.") |
| 131 | |
| 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.") |
| 140 | |
| 141 | (autoload 'autoload-rubric "autoload") |
| 142 | |
| 143 | (defconst finder--builtins-descriptions |
| 144 | ;; I have no idea whether these are supposed to be capitalized |
| 145 | ;; and/or end in a full-stop. Existing file headers are inconsistent, |
| 146 | ;; but mainly seem to not do so. |
| 147 | '((emacs . "the extensible text editor") |
| 148 | (nxml . "a new XML mode")) |
| 149 | "Alist of built-in package descriptions. |
| 150 | Entries have the form (PACKAGE-SYMBOL . DESCRIPTION). |
| 151 | When generating `package--builtins', this overrides what the description |
| 152 | would otherwise be.") |
| 153 | |
| 154 | (defvar finder--builtins-alist |
| 155 | '(("calc" . calc) |
| 156 | ("ede" . ede) |
| 157 | ("erc" . erc) |
| 158 | ("eshell" . eshell) |
| 159 | ("gnus" . gnus) |
| 160 | ("international" . emacs) |
| 161 | ("language" . emacs) |
| 162 | ("mh-e" . mh-e) |
| 163 | ("semantic" . semantic) |
| 164 | ("analyze" . semantic) |
| 165 | ("bovine" . semantic) |
| 166 | ("decorate" . semantic) |
| 167 | ("symref" . semantic) |
| 168 | ("wisent" . semantic) |
| 169 | ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el |
| 170 | ;; is the main file for the package. Then we would not need an |
| 171 | ;; entry in finder--builtins-descriptions. But I do not know if |
| 172 | ;; it is safe to change this, in case it is already in use. |
| 173 | ("nxml" . nxml) |
| 174 | ("org" . org) |
| 175 | ("srecode" . srecode) |
| 176 | ("term" . emacs) |
| 177 | ("url" . url)) |
| 178 | "Alist of built-in package directories. |
| 179 | Each element should have the form (DIR . PACKAGE), where DIR is a |
| 180 | directory name and PACKAGE is the name of a package (a symbol). |
| 181 | When generating `package--builtins', Emacs assumes any file in |
| 182 | DIR is part of the package PACKAGE.") |
| 183 | |
| 184 | (defun finder-compile-keywords (&rest dirs) |
| 185 | "Regenerate list of built-in Emacs packages. |
| 186 | This recomputes `package--builtins' and `finder-keywords-hash', |
| 187 | and prints them into the file `generated-finder-keywords-file'. |
| 188 | |
| 189 | Optional DIRS is a list of Emacs Lisp directories to compile |
| 190 | from; the default is `load-path'." |
| 191 | ;; Allow compressed files also. |
| 192 | (setq package--builtins nil) |
| 193 | (setq finder-keywords-hash (make-hash-table :test 'eq)) |
| 194 | (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$") |
| 195 | package-override files base-name ; processed |
| 196 | summary keywords package version entry desc) |
| 197 | (dolist (d (or dirs load-path)) |
| 198 | (when (file-exists-p (directory-file-name d)) |
| 199 | (message "Directory %s" d) |
| 200 | (setq package-override |
| 201 | (intern-soft |
| 202 | (cdr-safe |
| 203 | (assoc (file-name-nondirectory (directory-file-name d)) |
| 204 | finder--builtins-alist)))) |
| 205 | (setq files (directory-files d nil el-file-regexp)) |
| 206 | (dolist (f files) |
| 207 | (unless (or (string-match finder-no-scan-regexp f) |
| 208 | (null (setq base-name |
| 209 | (and (string-match el-file-regexp f) |
| 210 | (intern (match-string 1 f)))))) |
| 211 | ;; (memq base-name processed)) |
| 212 | ;; There are multiple files in the tree with the same basename. |
| 213 | ;; So skipping files based on basename means you randomly (depending |
| 214 | ;; on which order the files are traversed in) miss some packages. |
| 215 | ;; http://debbugs.gnu.org/14010 |
| 216 | ;; You might think this could lead to two files providing the same package, |
| 217 | ;; but it does not, because the duplicates are (at time of writing) |
| 218 | ;; all due to files in cedet, which end up with package-override set. |
| 219 | ;; FIXME this is obviously fragile. |
| 220 | ;; Make the (eq base-name package) case below issue a warning if |
| 221 | ;; package-override is nil? |
| 222 | ;; (push base-name processed) |
| 223 | (with-temp-buffer |
| 224 | (insert-file-contents (expand-file-name f d)) |
| 225 | (setq keywords (mapcar 'intern (lm-keywords-list)) |
| 226 | package (or package-override |
| 227 | (let ((str (lm-header "package"))) |
| 228 | (if str (intern str))) |
| 229 | base-name) |
| 230 | summary (or (cdr |
| 231 | (assq package finder--builtins-descriptions)) |
| 232 | (lm-synopsis)) |
| 233 | version (lm-header "version"))) |
| 234 | (when summary |
| 235 | (setq version (ignore-errors (version-to-list version))) |
| 236 | (setq entry (assq package package--builtins)) |
| 237 | (cond ((null entry) |
| 238 | (push (cons package |
| 239 | (package-make-builtin version summary)) |
| 240 | package--builtins)) |
| 241 | ;; The idea here is that eg calc.el gets to define |
| 242 | ;; the description of the calc package. |
| 243 | ;; This does not work for eg nxml-mode.el. |
| 244 | ((eq base-name package) |
| 245 | (setq desc (cdr entry)) |
| 246 | (aset desc 0 version) |
| 247 | (aset desc 2 summary))) |
| 248 | (dolist (kw keywords) |
| 249 | (puthash kw |
| 250 | (cons package |
| 251 | (delq package |
| 252 | (gethash kw finder-keywords-hash))) |
| 253 | finder-keywords-hash)))))))) |
| 254 | |
| 255 | (setq package--builtins |
| 256 | (sort package--builtins |
| 257 | (lambda (a b) (string< (symbol-name (car a)) |
| 258 | (symbol-name (car b)))))) |
| 259 | |
| 260 | (with-current-buffer |
| 261 | (find-file-noselect generated-finder-keywords-file) |
| 262 | (setq buffer-undo-list t) |
| 263 | (erase-buffer) |
| 264 | (insert (autoload-rubric generated-finder-keywords-file |
| 265 | "keyword-to-package mapping" t)) |
| 266 | (search-backward "\f") |
| 267 | ;; FIXME: Now that we have package--builtin-versions, package--builtins is |
| 268 | ;; only needed to get the list of unversioned packages and to get the |
| 269 | ;; summary description of each package. |
| 270 | (insert "(setq package--builtins '(\n") |
| 271 | (dolist (package package--builtins) |
| 272 | (insert " ") |
| 273 | (prin1 package (current-buffer)) |
| 274 | (insert "\n")) |
| 275 | (insert "))\n\n") |
| 276 | ;; Insert hash table. |
| 277 | (insert "(setq finder-keywords-hash\n ") |
| 278 | (prin1 finder-keywords-hash (current-buffer)) |
| 279 | (insert ")\n") |
| 280 | (basic-save-buffer))) |
| 281 | |
| 282 | (defun finder-compile-keywords-make-dist () |
| 283 | "Regenerate `finder-inf.el' for the Emacs distribution." |
| 284 | (apply 'finder-compile-keywords command-line-args-left) |
| 285 | (kill-emacs)) |
| 286 | |
| 287 | ;;; Now the retrieval code |
| 288 | |
| 289 | (defun finder-insert-at-column (column &rest strings) |
| 290 | "Insert, at column COLUMN, other args STRINGS." |
| 291 | (if (>= (current-column) column) (insert "\n")) |
| 292 | (move-to-column column t) |
| 293 | (apply 'insert strings)) |
| 294 | |
| 295 | (defvar finder-help-echo nil) |
| 296 | |
| 297 | (defun finder-mouse-face-on-line () |
| 298 | "Put `mouse-face' and `help-echo' properties on the previous line." |
| 299 | (save-excursion |
| 300 | (forward-line -1) |
| 301 | ;; If finder-insert-at-column moved us to a new line, go back one more. |
| 302 | (if (looking-at "[ \t]") (forward-line -1)) |
| 303 | (unless finder-help-echo |
| 304 | (setq finder-help-echo |
| 305 | (let* ((keys1 (where-is-internal 'finder-select |
| 306 | finder-mode-map)) |
| 307 | (keys (nconc (where-is-internal |
| 308 | 'finder-mouse-select finder-mode-map) |
| 309 | keys1))) |
| 310 | (concat (mapconcat 'key-description keys ", ") |
| 311 | ": select item")))) |
| 312 | (add-text-properties |
| 313 | (line-beginning-position) (line-end-position) |
| 314 | '(mouse-face highlight |
| 315 | help-echo finder-help-echo)))) |
| 316 | |
| 317 | (defun finder-unknown-keywords () |
| 318 | "Return an alist of unknown keywords and number of their occurrences. |
| 319 | Unknown keywords are those present in `finder-keywords-hash' but |
| 320 | not `finder-known-keywords'." |
| 321 | (let (alist) |
| 322 | (maphash (lambda (kw packages) |
| 323 | (unless (assq kw finder-known-keywords) |
| 324 | (push (cons kw (length packages)) alist))) |
| 325 | finder-keywords-hash) |
| 326 | (sort alist (lambda (a b) (string< (car a) (car b)))))) |
| 327 | |
| 328 | ;;;###autoload |
| 329 | (defun finder-list-keywords () |
| 330 | "Display descriptions of the keywords in the Finder buffer." |
| 331 | (interactive) |
| 332 | (if (get-buffer "*Finder*") |
| 333 | (pop-to-buffer "*Finder*") |
| 334 | (pop-to-buffer (get-buffer-create "*Finder*")) |
| 335 | (finder-mode) |
| 336 | (let ((inhibit-read-only t)) |
| 337 | (erase-buffer) |
| 338 | (dolist (assoc finder-known-keywords) |
| 339 | (let ((keyword (car assoc))) |
| 340 | (insert (propertize (symbol-name keyword) |
| 341 | 'font-lock-face 'font-lock-constant-face)) |
| 342 | (finder-insert-at-column 14 (concat (cdr assoc) "\n")) |
| 343 | (finder-mouse-face-on-line))) |
| 344 | (goto-char (point-min)) |
| 345 | (setq finder-headmark (point) |
| 346 | buffer-read-only t) |
| 347 | (set-buffer-modified-p nil) |
| 348 | (balance-windows) |
| 349 | (finder-summary)))) |
| 350 | |
| 351 | (defun finder-list-matches (key) |
| 352 | (let* ((id (intern key)) |
| 353 | (packages (gethash id finder-keywords-hash))) |
| 354 | (unless packages |
| 355 | (error "No packages matching key `%s'" key)) |
| 356 | (let ((package-list-unversioned t)) |
| 357 | (package-show-package-list packages)))) |
| 358 | |
| 359 | (define-button-type 'finder-xref 'action #'finder-goto-xref) |
| 360 | |
| 361 | (defun finder-goto-xref (button) |
| 362 | "Jump to a lisp file for the BUTTON at point." |
| 363 | (let* ((file (button-get button 'xref)) |
| 364 | (lib (locate-library file))) |
| 365 | (if lib (finder-commentary lib) |
| 366 | (message "Unable to locate `%s'" file)))) |
| 367 | |
| 368 | ;;;###autoload |
| 369 | (defun finder-commentary (file) |
| 370 | "Display FILE's commentary section. |
| 371 | FILE should be in a form suitable for passing to `locate-library'." |
| 372 | (interactive |
| 373 | (list |
| 374 | (completing-read "Library name: " |
| 375 | (apply-partially 'locate-file-completion-table |
| 376 | (or find-function-source-path load-path) |
| 377 | (find-library-suffixes))))) |
| 378 | (let ((str (lm-commentary (find-library-name file)))) |
| 379 | (or str (error "Can't find any Commentary section")) |
| 380 | ;; This used to use *Finder* but that would clobber the |
| 381 | ;; directory of categories. |
| 382 | (pop-to-buffer "*Finder-package*") |
| 383 | (setq buffer-read-only nil |
| 384 | buffer-undo-list t) |
| 385 | (erase-buffer) |
| 386 | (insert str) |
| 387 | (goto-char (point-min)) |
| 388 | (delete-blank-lines) |
| 389 | (goto-char (point-max)) |
| 390 | (delete-blank-lines) |
| 391 | (goto-char (point-min)) |
| 392 | (while (re-search-forward "^;+ ?" nil t) |
| 393 | (replace-match "" nil nil)) |
| 394 | (goto-char (point-min)) |
| 395 | (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t) |
| 396 | (if (locate-library (match-string 1)) |
| 397 | (make-text-button (match-beginning 1) (match-end 1) |
| 398 | 'xref (match-string-no-properties 1) |
| 399 | 'help-echo "Read this file's commentary" |
| 400 | :type 'finder-xref))) |
| 401 | (goto-char (point-min)) |
| 402 | (setq buffer-read-only t) |
| 403 | (set-buffer-modified-p nil) |
| 404 | (shrink-window-if-larger-than-buffer) |
| 405 | (finder-mode) |
| 406 | (finder-summary))) |
| 407 | |
| 408 | (defun finder-current-item () |
| 409 | (let ((key (save-excursion |
| 410 | (beginning-of-line) |
| 411 | (current-word)))) |
| 412 | (if (or (and finder-headmark (< (point) finder-headmark)) |
| 413 | (zerop (length key))) |
| 414 | (error "No keyword or filename on this line") |
| 415 | key))) |
| 416 | |
| 417 | (defun finder-select () |
| 418 | "Select item on current line in a Finder buffer." |
| 419 | (interactive) |
| 420 | (let ((key (finder-current-item))) |
| 421 | (if (string-match "\\.el$" key) |
| 422 | (finder-commentary key) |
| 423 | (finder-list-matches key)))) |
| 424 | |
| 425 | (defun finder-mouse-select (event) |
| 426 | "Select item in a Finder buffer with the mouse." |
| 427 | (interactive "e") |
| 428 | (with-current-buffer (window-buffer (posn-window (event-start event))) |
| 429 | (goto-char (posn-point (event-start event))) |
| 430 | (finder-select))) |
| 431 | |
| 432 | ;;;###autoload |
| 433 | (defun finder-by-keyword () |
| 434 | "Find packages matching a given keyword." |
| 435 | (interactive) |
| 436 | (finder-list-keywords)) |
| 437 | |
| 438 | (define-derived-mode finder-mode nil "Finder" |
| 439 | "Major mode for browsing package documentation. |
| 440 | \\<finder-mode-map> |
| 441 | \\[finder-select] more help for the item on the current line |
| 442 | \\[finder-exit] exit Finder mode and kill the Finder buffer." |
| 443 | :syntax-table finder-mode-syntax-table |
| 444 | (setq buffer-read-only t |
| 445 | buffer-undo-list t) |
| 446 | (set (make-local-variable 'finder-headmark) nil)) |
| 447 | |
| 448 | (defun finder-summary () |
| 449 | "Summarize basic Finder commands." |
| 450 | (interactive) |
| 451 | (message "%s" |
| 452 | (substitute-command-keys |
| 453 | "\\<finder-mode-map>\\[finder-select] = select, \ |
| 454 | \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \ |
| 455 | finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"))) |
| 456 | |
| 457 | (defun finder-exit () |
| 458 | "Exit Finder mode. |
| 459 | Delete the window and kill all Finder-related buffers." |
| 460 | (interactive) |
| 461 | (ignore-errors (delete-window)) |
| 462 | (let ((buf "*Finder*")) |
| 463 | (and (get-buffer buf) (kill-buffer buf)))) |
| 464 | |
| 465 | (defun finder-unload-function () |
| 466 | "Unload the Finder library." |
| 467 | (with-demoted-errors (unload-feature 'finder-inf t)) |
| 468 | ;; continue standard unloading |
| 469 | nil) |
| 470 | |
| 471 | \f |
| 472 | (provide 'finder) |
| 473 | |
| 474 | ;;; finder.el ends here |