lisp/finder.el

   1 ;;; finder.el --- topic & keyword-based code finder
   2
   3 ;; Copyright (C) 1992, 1997-1999, 2001-2015 Free Software Foundation,
   4 ;; Inc.
   5
   6 ;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
   7 ;; Created: 16 Jun 1992
   8 ;; Version: 1.0
   9 ;; Keywords: help
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software: you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; This mode uses the Keywords library header to provide code-finding
  29 ;; services by keyword.
  30
  31 ;;; Code:
  32
  33 (require 'package)
  34 (require 'lisp-mnt)
  35 (require 'find-func) ;for find-library(-suffixes)
  36 (require 'finder-inf nil t)
  37
  38 ;; These are supposed to correspond to top-level customization groups,
  39 ;; says rms.
  40 (defvar finder-known-keywords
  41   '((abbrev     . "abbreviation handling, typing shortcuts, and macros")
  42     (bib        . "bibliography processors")
  43     (c          . "C and related programming languages")
  44     (calendar   . "calendar and time management tools")
  45     (comm       . "communications, networking, and remote file access")
  46     (convenience . "convenience features for faster editing")
  47     (data       . "editing data (non-text) files")
  48     (docs       . "Emacs documentation facilities")
  49     (emulations . "emulations of other editors")
  50     (extensions . "Emacs Lisp language extensions")
  51     (faces      . "fonts and colors for text")
  52     (files      . "file editing and manipulation")
  53     (frames     . "Emacs frames and window systems")
  54     (games      . "games, jokes and amusements")
  55     (hardware   . "interfacing with system hardware")
  56     (help       . "Emacs help systems")
  57     (hypermedia . "links between text or other media types")
  58     (i18n       . "internationalization and character-set support")
  59     (internal   . "code for Emacs internals, build process, defaults")
  60     (languages  . "specialized modes for editing programming languages")
  61     (lisp       . "Lisp support, including Emacs Lisp")
  62     (local      . "code local to your site")
  63     (maint      . "Emacs development tools and aids")
  64     (mail       . "email reading and posting")
  65     (matching   . "searching, matching, and sorting")
  66     (mouse      . "mouse support")
  67     (multimedia . "images and sound")
  68     (news       . "USENET news reading and posting")
  69     (outlines   . "hierarchical outlining and note taking")
  70     (processes  . "processes, subshells, and compilation")
  71     (terminals  . "text terminals (ttys)")
  72     (tex        . "the TeX document formatter")
  73     (tools      . "programming tools")
  74     (unix       . "UNIX feature interfaces and emulators")
  75     (vc         . "version control")
  76     (wp         . "word processing"))
  77   "Association list of the standard \"Keywords:\" headers.
  78 Each element has the form (KEYWORD . DESCRIPTION).")
  79
  80 (defvar finder-mode-map
  81   (let ((map (make-sparse-keymap))
  82         (menu-map (make-sparse-keymap "Finder")))
  83     (define-key map " " 'finder-select)
  84     (define-key map "f" 'finder-select)
  85     (define-key map [follow-link] 'mouse-face)
  86     (define-key map [mouse-2]   'finder-mouse-select)
  87     (define-key map "\C-m"      'finder-select)
  88     (define-key map "?" 'finder-summary)
  89     (define-key map "n" 'next-line)
  90     (define-key map "p" 'previous-line)
  91     (define-key map "q" 'finder-exit)
  92     (define-key map "d" 'finder-list-keywords)
  93
  94     (define-key map [menu-bar finder-mode]
  95       (cons "Finder" menu-map))
  96     (define-key menu-map [finder-exit]
  97       '(menu-item "Quit" finder-exit
  98                   :help "Exit Finder mode"))
  99     (define-key menu-map [finder-summary]
 100       '(menu-item "Summary" finder-summary
 101                   :help "Summary item on current line in a finder buffer"))
 102     (define-key menu-map [finder-list-keywords]
 103       '(menu-item "List keywords" finder-list-keywords
 104                   :help "Display descriptions of the keywords in the Finder buffer"))
 105     (define-key menu-map [finder-select]
 106       '(menu-item "Select" finder-select
 107                   :help "Select item on current line in a finder buffer"))
 108     map)
 109   "Keymap used in `finder-mode'.")
 110
 111 (defvar finder-mode-syntax-table
 112   (let ((st (make-syntax-table emacs-lisp-mode-syntax-table)))
 113     (modify-syntax-entry ?\; ".   " st)
 114     st)
 115   "Syntax table used while in `finder-mode'.")
 116
 117 (defvar finder-font-lock-keywords
 118   '(("`\\([^'`]+\\)'" 1 font-lock-constant-face prepend))
 119   "Font-lock keywords for Finder mode.")
 120
 121 (defvar finder-headmark nil
 122   "Internal Finder mode variable, local in Finder buffer.")
 123
 124 ;;; Code for regenerating the keyword list.
 125
 126 (defvar finder-keywords-hash nil
 127   "Hash table mapping keywords to lists of package names.
 128 Keywords and package names both should be symbols.")
 129
 130 (defvar generated-finder-keywords-file "finder-inf.el"
 131   "The function `finder-compile-keywords' writes keywords into this file.")
 132
 133 ;; Skip autogenerated files, because they will never contain anything
 134 ;; useful, and because in parallel builds of Emacs they may get
 135 ;; modified while we are trying to read them.
 136 ;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
 137 ;; ldefs-boot is not auto-generated, but has nothing useful.
 138 (defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|ldefs-boot\\|\
 139 cus-load\\|finder-inf\\|esh-groups\\|subdirs\\|leim-list\\)\\.el$\\)"
 140   "Regexp matching file names not to scan for keywords.")
 141
 142 (autoload 'autoload-rubric "autoload")
 143
 144 (defconst finder--builtins-descriptions
 145   ;; I have no idea whether these are supposed to be capitalized
 146   ;; and/or end in a full-stop.  Existing file headers are inconsistent,
 147   ;; but mainly seem to not do so.
 148   '((emacs . "the extensible text editor")
 149     (nxml . "a new XML mode"))
 150   "Alist of built-in package descriptions.
 151 Entries have the form (PACKAGE-SYMBOL . DESCRIPTION).
 152 When generating `package--builtins', this overrides what the description
 153 would otherwise be.")
 154
 155 (defvar finder--builtins-alist
 156   '(("calc" . calc)
 157     ("ede"  . ede)
 158     ("erc"  . erc)
 159     ("eshell" . eshell)
 160     ("gnus" . gnus)
 161     ("international" . emacs)
 162     ("language" . emacs)
 163     ("mh-e" . mh-e)
 164     ("semantic" . semantic)
 165     ("analyze" . semantic)
 166     ("bovine" . semantic)
 167     ("decorate" . semantic)
 168     ("symref" . semantic)
 169     ("wisent" . semantic)
 170     ;; This should really be ("nxml" . nxml-mode), because nxml-mode.el
 171     ;; is the main file for the package.  Then we would not need an
 172     ;; entry in finder--builtins-descriptions.  But I do not know if
 173     ;; it is safe to change this, in case it is already in use.
 174     ("nxml" . nxml)
 175     ("org"  . org)
 176     ("srecode" . srecode)
 177     ("term" . emacs)
 178     ("url"  . url))
 179   "Alist of built-in package directories.
 180 Each element should have the form (DIR . PACKAGE), where DIR is a
 181 directory name and PACKAGE is the name of a package (a symbol).
 182 When generating `package--builtins', Emacs assumes any file in
 183 DIR is part of the package PACKAGE.")
 184
 185 (defun finder-compile-keywords (&rest dirs)
 186   "Regenerate list of built-in Emacs packages.
 187 This recomputes `package--builtins' and `finder-keywords-hash',
 188 and prints them into the file `generated-finder-keywords-file'.
 189
 190 Optional DIRS is a list of Emacs Lisp directories to compile
 191 from; the default is `load-path'."
 192   ;; Allow compressed files also.
 193   (setq package--builtins nil)
 194   (setq finder-keywords-hash (make-hash-table :test 'eq))
 195   (let ((el-file-regexp "^\\([^=].*\\)\\.el\\(\\.\\(gz\\|Z\\)\\)?$")
 196         package-override files base-name ; processed
 197         summary keywords package version entry desc)
 198     (dolist (d (or dirs load-path))
 199       (when (file-exists-p (directory-file-name d))
 200         (message "Directory %s" d)
 201         (setq package-override
 202               (intern-soft
 203                (cdr-safe
 204                 (assoc (file-name-nondirectory (directory-file-name d))
 205                        finder--builtins-alist))))
 206         (setq files (directory-files d nil el-file-regexp))
 207         (dolist (f files)
 208           (unless (or (string-match finder-no-scan-regexp f)
 209                       (null (setq base-name
 210                                   (and (string-match el-file-regexp f)
 211                                        (intern (match-string 1 f))))))
 212 ;;                    (memq base-name processed))
 213 ;; There are multiple files in the tree with the same basename.
 214 ;; So skipping files based on basename means you randomly (depending
 215 ;; on which order the files are traversed in) miss some packages.
 216 ;; http://debbugs.gnu.org/14010
 217 ;; You might think this could lead to two files providing the same package,
 218 ;; but it does not, because the duplicates are (at time of writing)
 219 ;; all due to files in cedet, which end up with package-override set.
 220 ;; FIXME this is obviously fragile.
 221 ;; Make the (eq base-name package) case below issue a warning if
 222 ;; package-override is nil?
 223 ;;          (push base-name processed)
 224             (with-temp-buffer
 225               (insert-file-contents (expand-file-name f d))
 226               (setq keywords (mapcar 'intern (lm-keywords-list))
 227                     package  (or package-override
 228                                  (let ((str (lm-header "package")))
 229                                    (if str (intern str)))
 230                                  base-name)
 231                     summary  (or (cdr
 232                                   (assq package finder--builtins-descriptions))
 233                                  (lm-synopsis))
 234                     version  (lm-header "version")))
 235             (when summary
 236               (setq version (ignore-errors (version-to-list version)))
 237               (setq entry (assq package package--builtins))
 238               (cond ((null entry)
 239                      (push (cons package
 240                                  (package-make-builtin version summary))
 241                            package--builtins))
 242                     ;; The idea here is that eg calc.el gets to define
 243                     ;; the description of the calc package.
 244                     ;; This does not work for eg nxml-mode.el.
 245                     ((eq base-name package)
 246                      (setq desc (cdr entry))
 247                      (aset desc 0 version)
 248                      (aset desc 2 summary)))
 249               (dolist (kw keywords)
 250                 (puthash kw
 251                          (cons package
 252                                (delq package
 253                                      (gethash kw finder-keywords-hash)))
 254                          finder-keywords-hash))))))))
 255
 256   (setq package--builtins
 257         (sort package--builtins
 258               (lambda (a b) (string< (symbol-name (car a))
 259                                      (symbol-name (car b))))))
 260
 261   (with-current-buffer
 262       (find-file-noselect generated-finder-keywords-file)
 263     (setq buffer-undo-list t)
 264     (erase-buffer)
 265     (insert (autoload-rubric generated-finder-keywords-file
 266                              "keyword-to-package mapping" t))
 267     (search-backward "\f")
 268     ;; FIXME: Now that we have package--builtin-versions, package--builtins is
 269     ;; only needed to get the list of unversioned packages and to get the
 270     ;; summary description of each package.
 271     (insert "(setq package--builtins '(\n")
 272     (dolist (package package--builtins)
 273       (insert "  ")
 274       (prin1 package (current-buffer))
 275       (insert "\n"))
 276     (insert "))\n\n")
 277     ;; Insert hash table.
 278     (insert "(setq finder-keywords-hash\n      ")
 279     (prin1 finder-keywords-hash (current-buffer))
 280     (insert ")\n")
 281     (basic-save-buffer)))
 282
 283 (defun finder-compile-keywords-make-dist ()
 284   "Regenerate `finder-inf.el' for the Emacs distribution."
 285   (apply 'finder-compile-keywords command-line-args-left)
 286   (kill-emacs))
 287
 288 ;;; Now the retrieval code
 289
 290 (defun finder-insert-at-column (column &rest strings)
 291   "Insert, at column COLUMN, other args STRINGS."
 292   (if (>= (current-column) column) (insert "\n"))
 293   (move-to-column column t)
 294   (apply 'insert strings))
 295
 296 (defvar finder-help-echo nil)
 297
 298 (defun finder-mouse-face-on-line ()
 299   "Put `mouse-face' and `help-echo' properties on the previous line."
 300   (save-excursion
 301     (forward-line -1)
 302     ;; If finder-insert-at-column moved us to a new line, go back one more.
 303     (if (looking-at "[ \t]") (forward-line -1))
 304     (unless finder-help-echo
 305       (setq finder-help-echo
 306             (let* ((keys1 (where-is-internal 'finder-select
 307                                              finder-mode-map))
 308                    (keys (nconc (where-is-internal
 309                                  'finder-mouse-select finder-mode-map)
 310                                 keys1)))
 311               (concat (mapconcat 'key-description keys ", ")
 312                       ": select item"))))
 313     (add-text-properties
 314      (line-beginning-position) (line-end-position)
 315      '(mouse-face highlight
 316                   help-echo finder-help-echo))))
 317
 318 (defun finder-unknown-keywords ()
 319   "Return an alist of unknown keywords and number of their occurrences.
 320 Unknown keywords are those present in `finder-keywords-hash' but
 321 not `finder-known-keywords'."
 322   (let (alist)
 323     (maphash (lambda (kw packages)
 324                (unless (assq kw finder-known-keywords)
 325                  (push (cons kw (length packages)) alist)))
 326              finder-keywords-hash)
 327     (sort alist (lambda (a b) (string< (car a) (car b))))))
 328
 329 ;;;###autoload
 330 (defun finder-list-keywords ()
 331   "Display descriptions of the keywords in the Finder buffer."
 332   (interactive)
 333   (if (get-buffer "*Finder*")
 334       (pop-to-buffer "*Finder*")
 335     (pop-to-buffer (get-buffer-create "*Finder*"))
 336     (finder-mode)
 337     (let ((inhibit-read-only t))
 338       (erase-buffer)
 339       (dolist (assoc finder-known-keywords)
 340         (let ((keyword (car assoc)))
 341           (insert (propertize (symbol-name keyword)
 342                               'font-lock-face 'font-lock-constant-face))
 343           (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
 344           (finder-mouse-face-on-line)))
 345       (goto-char (point-min))
 346       (setq finder-headmark (point)
 347             buffer-read-only t)
 348       (set-buffer-modified-p nil)
 349       (balance-windows)
 350       (finder-summary))))
 351
 352 (defun finder-list-matches (key)
 353   (let* ((id (intern key))
 354          (packages (gethash id finder-keywords-hash)))
 355     (unless packages
 356       (error "No packages matching key `%s'" key))
 357     (let ((package-list-unversioned t))
 358       (package-show-package-list packages))))
 359
 360 (define-button-type 'finder-xref 'action #'finder-goto-xref)
 361
 362 (defun finder-goto-xref (button)
 363   "Jump to a lisp file for the BUTTON at point."
 364   (let* ((file (button-get button 'xref))
 365          (lib (locate-library file)))
 366     (if lib (finder-commentary lib)
 367       (message "Unable to locate `%s'" file))))
 368
 369 ;;;###autoload
 370 (defun finder-commentary (file)
 371   "Display FILE's commentary section.
 372 FILE should be in a form suitable for passing to `locate-library'."
 373   (interactive
 374    (list
 375     (completing-read "Library name: "
 376                      (apply-partially 'locate-file-completion-table
 377                                       (or find-function-source-path load-path)
 378                                       (find-library-suffixes)))))
 379   (let ((str (lm-commentary (find-library-name file))))
 380     (or str (error "Can't find any Commentary section"))
 381     ;; This used to use *Finder* but that would clobber the
 382     ;; directory of categories.
 383     (pop-to-buffer "*Finder-package*")
 384     (setq buffer-read-only nil
 385           buffer-undo-list t)
 386     (erase-buffer)
 387     (insert str)
 388     (goto-char (point-min))
 389     (delete-blank-lines)
 390     (goto-char (point-max))
 391     (delete-blank-lines)
 392     (goto-char (point-min))
 393     (while (re-search-forward "^;+ ?" nil t)
 394       (replace-match "" nil nil))
 395     (goto-char (point-min))
 396     (while (re-search-forward "\\<\\([-[:alnum:]]+\\.el\\)\\>" nil t)
 397       (if (locate-library (match-string 1))
 398           (make-text-button (match-beginning 1) (match-end 1)
 399                             'xref (match-string-no-properties 1)
 400                             'help-echo "Read this file's commentary"
 401                             :type 'finder-xref)))
 402     (goto-char (point-min))
 403     (setq buffer-read-only t)
 404     (set-buffer-modified-p nil)
 405     (shrink-window-if-larger-than-buffer)
 406     (finder-mode)
 407     (finder-summary)))
 408
 409 (defun finder-current-item ()
 410   (let ((key (save-excursion
 411                (beginning-of-line)
 412                (current-word))))
 413     (if (or (and finder-headmark (< (point) finder-headmark))
 414             (zerop (length key)))
 415         (error "No keyword or filename on this line")
 416       key)))
 417
 418 (defun finder-select ()
 419   "Select item on current line in a Finder buffer."
 420   (interactive)
 421   (let ((key (finder-current-item)))
 422       (if (string-match "\\.el$" key)
 423           (finder-commentary key)
 424         (finder-list-matches key))))
 425
 426 (defun finder-mouse-select (event)
 427   "Select item in a Finder buffer with the mouse."
 428   (interactive "e")
 429   (with-current-buffer (window-buffer (posn-window (event-start event)))
 430     (goto-char (posn-point (event-start event)))
 431     (finder-select)))
 432
 433 ;;;###autoload
 434 (defun finder-by-keyword ()
 435   "Find packages matching a given keyword."
 436   (interactive)
 437   (finder-list-keywords))
 438
 439 (define-derived-mode finder-mode nil "Finder"
 440   "Major mode for browsing package documentation.
 441 \\<finder-mode-map>
 442 \\[finder-select]       more help for the item on the current line
 443 \\[finder-exit] exit Finder mode and kill the Finder buffer."
 444   :syntax-table finder-mode-syntax-table
 445   (setq buffer-read-only t
 446         buffer-undo-list t)
 447   (set (make-local-variable 'finder-headmark) nil))
 448
 449 (defun finder-summary ()
 450   "Summarize basic Finder commands."
 451   (interactive)
 452   (message "%s"
 453    (substitute-command-keys
 454     "\\<finder-mode-map>\\[finder-select] = select, \
 455 \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \
 456 finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
 457
 458 (defun finder-exit ()
 459   "Exit Finder mode.
 460 Delete the window and kill all Finder-related buffers."
 461   (interactive)
 462   (ignore-errors (delete-window))
 463   (let ((buf "*Finder*"))
 464     (and (get-buffer buf) (kill-buffer buf))))
 465
 466 (defun finder-unload-function ()
 467   "Unload the Finder library."
 468   (with-demoted-errors (unload-feature 'finder-inf t))
 469   ;; continue standard unloading
 470   nil)
 471
 472 \f
 473 (provide 'finder)
 474
 475 ;;; finder.el ends here