| 1 | ;;; finder.el --- topic & keyword-based code finder |
| 2 | |
| 3 | ;; Copyright (C) 1992, 1997, 1998, 1999, 2001, 2002, 2003, |
| 4 | ;; 2004, 2005, 2006, 2007 Free Software Foundation, 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 2, or (at your option) |
| 16 | ;; 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; see the file COPYING. If not, write to the |
| 25 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
| 26 | ;; Boston, MA 02110-1301, USA. |
| 27 | |
| 28 | ;;; Commentary: |
| 29 | |
| 30 | ;; This mode uses the Keywords library header to provide code-finding |
| 31 | ;; services by keyword. |
| 32 | ;; |
| 33 | ;; Things to do: |
| 34 | ;; 1. Support multiple keywords per search. This could be extremely hairy; |
| 35 | ;; there doesn't seem to be any way to get completing-read to exit on |
| 36 | ;; an EOL with no substring pending, which is what we'd want to end the loop. |
| 37 | ;; 2. Search by string in synopsis line? |
| 38 | ;; 3. Function to check finder-package-info for unknown keywords. |
| 39 | |
| 40 | ;;; Code: |
| 41 | |
| 42 | (require 'lisp-mnt) |
| 43 | (require 'find-func) ;for find-library(-suffixes) |
| 44 | ;; Use `load' rather than `require' so that it doesn't get loaded |
| 45 | ;; during byte-compilation (at which point it might be missing). |
| 46 | (load "finder-inf" t t) |
| 47 | |
| 48 | (defvar finder-mode-hook nil |
| 49 | "*Hook run when function `finder-mode' is called.") |
| 50 | |
| 51 | ;; Local variable in finder buffer. |
| 52 | (defvar finder-headmark) |
| 53 | |
| 54 | ;; These are supposed to correspond to top-level customization groups, |
| 55 | ;; says rms. |
| 56 | (defvar finder-known-keywords |
| 57 | '( |
| 58 | (abbrev . "abbreviation handling, typing shortcuts, macros") |
| 59 | ;; Too specific: |
| 60 | (bib . "code related to the `bib' bibliography processor") |
| 61 | (c . "support for the C language and related languages") |
| 62 | (calendar . "calendar and time management support") |
| 63 | (comm . "communications, networking, remote access to files") |
| 64 | (convenience . "convenience features for faster editing") |
| 65 | (data . "support for editing files of data") |
| 66 | (docs . "support for Emacs documentation") |
| 67 | (emulations . "emulations of other editors") |
| 68 | (extensions . "Emacs Lisp language extensions") |
| 69 | (faces . "support for multiple fonts") |
| 70 | (files . "support for editing and manipulating files") |
| 71 | (frames . "support for Emacs frames and window systems") |
| 72 | (games . "games, jokes and amusements") |
| 73 | (hardware . "support for interfacing with exotic hardware") |
| 74 | (help . "support for on-line help systems") |
| 75 | (hypermedia . "support for links between text or other media types") |
| 76 | (i18n . "internationalization and alternate character-set support") |
| 77 | (internal . "code for Emacs internals, build process, defaults") |
| 78 | (languages . "specialized modes for editing programming languages") |
| 79 | (lisp . "Lisp support, including Emacs Lisp") |
| 80 | (local . "code local to your site") |
| 81 | (maint . "maintenance aids for the Emacs development group") |
| 82 | (mail . "modes for electronic-mail handling") |
| 83 | (matching . "various sorts of searching and matching") |
| 84 | (mouse . "mouse support") |
| 85 | (multimedia . "images and sound support") |
| 86 | (news . "support for netnews reading and posting") |
| 87 | (oop . "support for object-oriented programming") |
| 88 | (outlines . "support for hierarchical outlining") |
| 89 | (processes . "process, subshell, compilation, and job control support") |
| 90 | (terminals . "support for terminal types") |
| 91 | (tex . "supporting code for the TeX formatter") |
| 92 | (tools . "programming tools") |
| 93 | (unix . "front-ends/assistants for, or emulators of, UNIX-like features") |
| 94 | ;; Not a custom group and not currently useful. |
| 95 | ;; (vms . "support code for vms") |
| 96 | (wp . "word processing") |
| 97 | )) |
| 98 | |
| 99 | (defvar finder-mode-map |
| 100 | (let ((map (make-sparse-keymap))) |
| 101 | (define-key map " " 'finder-select) |
| 102 | (define-key map "f" 'finder-select) |
| 103 | (define-key map [follow-link] 'mouse-face) |
| 104 | (define-key map [mouse-2] 'finder-mouse-select) |
| 105 | (define-key map "\C-m" 'finder-select) |
| 106 | (define-key map "?" 'finder-summary) |
| 107 | (define-key map "n" 'next-line) |
| 108 | (define-key map "p" 'previous-line) |
| 109 | (define-key map "q" 'finder-exit) |
| 110 | (define-key map "d" 'finder-list-keywords) |
| 111 | map)) |
| 112 | |
| 113 | |
| 114 | ;;; Code for regenerating the keyword list. |
| 115 | |
| 116 | (defvar finder-package-info nil |
| 117 | "Assoc list mapping file names to description & keyword lists.") |
| 118 | |
| 119 | (defvar generated-finder-keywords-file "finder-inf.el" |
| 120 | "File \\[finder-compile-keywords] puts finder keywords into.") |
| 121 | |
| 122 | (defun finder-compile-keywords (&rest dirs) |
| 123 | "Regenerate the keywords association list into `generated-finder-keywords-file'. |
| 124 | Optional arguments DIRS are a list of Emacs Lisp directories to compile from; |
| 125 | no arguments compiles from `load-path'." |
| 126 | (save-excursion |
| 127 | (let ((processed nil)) |
| 128 | (find-file generated-finder-keywords-file) |
| 129 | (erase-buffer) |
| 130 | (insert ";;; " (file-name-nondirectory generated-finder-keywords-file) |
| 131 | " --- keyword-to-package mapping\n") |
| 132 | (insert ";; This file is part of GNU Emacs.\n") |
| 133 | (insert ";;; Commentary:\n") |
| 134 | (insert ";; Don't edit this file. It's generated by finder.el\n\n") |
| 135 | (insert ";;; Code:\n") |
| 136 | (insert "\n(setq finder-package-info '(\n") |
| 137 | (mapcar |
| 138 | (lambda (d) |
| 139 | (when (file-exists-p (directory-file-name d)) |
| 140 | (message "Directory %s" d) |
| 141 | (mapcar |
| 142 | (lambda (f) |
| 143 | (if (and (or (string-match "^[^=].*\\.el$" f) |
| 144 | ;; Allow compressed files also. Fixme: |
| 145 | ;; generalize this, especially for |
| 146 | ;; MS-DOG-type filenames. |
| 147 | (and (string-match "^[^=].*\\.el\\.\\(gz\\|Z\\)$" f) |
| 148 | (require 'jka-compr))) |
| 149 | ;; Ignore lock files. |
| 150 | (not (string-match "^.#" f)) |
| 151 | (not (member f processed))) |
| 152 | (let (summary keystart keywords) |
| 153 | (setq processed (cons f processed)) |
| 154 | (save-excursion |
| 155 | (set-buffer (get-buffer-create "*finder-scratch*")) |
| 156 | (buffer-disable-undo (current-buffer)) |
| 157 | (erase-buffer) |
| 158 | (insert-file-contents |
| 159 | (concat (file-name-as-directory (or d ".")) f)) |
| 160 | (setq summary (lm-synopsis)) |
| 161 | (setq keywords (lm-keywords))) |
| 162 | (insert |
| 163 | (format " (\"%s\"\n " |
| 164 | (if (string-match "\\.\\(gz\\|Z\\)$" f) |
| 165 | (file-name-sans-extension f) |
| 166 | f))) |
| 167 | (prin1 summary (current-buffer)) |
| 168 | (insert |
| 169 | "\n ") |
| 170 | (setq keystart (point)) |
| 171 | (insert |
| 172 | (if keywords (format "(%s)" keywords) "nil") |
| 173 | ")\n") |
| 174 | (subst-char-in-region keystart (point) ?, ? ) |
| 175 | ))) |
| 176 | (directory-files (or d "."))))) |
| 177 | (or dirs load-path)) |
| 178 | (insert "))\n |
| 179 | \(provide '" (file-name-sans-extension |
| 180 | (file-name-nondirectory generated-finder-keywords-file)) ") |
| 181 | |
| 182 | ;;; Local Variables: |
| 183 | ;;; version-control: never |
| 184 | ;;; no-byte-compile: t |
| 185 | ;;; no-update-autoloads: t |
| 186 | ;;; End: |
| 187 | ;;; " (file-name-nondirectory generated-finder-keywords-file) " ends here\n") |
| 188 | (kill-buffer "*finder-scratch*") |
| 189 | (eval-buffer) ;; So we get the new keyword list immediately |
| 190 | (basic-save-buffer)))) |
| 191 | |
| 192 | (defun finder-compile-keywords-make-dist () |
| 193 | "Regenerate `finder-inf.el' for the Emacs distribution." |
| 194 | (apply 'finder-compile-keywords command-line-args-left) |
| 195 | (kill-emacs)) |
| 196 | |
| 197 | ;;; Now the retrieval code |
| 198 | |
| 199 | (defun finder-insert-at-column (column &rest strings) |
| 200 | "Insert, at column COLUMN, other args STRINGS." |
| 201 | (if (>= (current-column) column) (insert "\n")) |
| 202 | (move-to-column column t) |
| 203 | (apply 'insert strings)) |
| 204 | |
| 205 | (defvar finder-help-echo nil) |
| 206 | |
| 207 | (defun finder-mouse-face-on-line () |
| 208 | "Put `mouse-face' and `help-echo' properties on the previous line." |
| 209 | (save-excursion |
| 210 | (previous-line 1) |
| 211 | (unless finder-help-echo |
| 212 | (setq finder-help-echo |
| 213 | (let* ((keys1 (where-is-internal 'finder-select |
| 214 | finder-mode-map)) |
| 215 | (keys (nconc (where-is-internal |
| 216 | 'finder-mouse-select finder-mode-map) |
| 217 | keys1))) |
| 218 | (concat (mapconcat 'key-description keys ", ") |
| 219 | ": select item")))) |
| 220 | (add-text-properties |
| 221 | (line-beginning-position) (line-end-position) |
| 222 | '(mouse-face highlight |
| 223 | help-echo finder-help-echo)))) |
| 224 | |
| 225 | ;;;###autoload |
| 226 | (defun finder-list-keywords () |
| 227 | "Display descriptions of the keywords in the Finder buffer." |
| 228 | (interactive) |
| 229 | (if (get-buffer "*Finder*") |
| 230 | (pop-to-buffer "*Finder*") |
| 231 | (pop-to-buffer (set-buffer (get-buffer-create "*Finder*"))) |
| 232 | (finder-mode) |
| 233 | (setq buffer-read-only nil) |
| 234 | (erase-buffer) |
| 235 | (mapc |
| 236 | (lambda (assoc) |
| 237 | (let ((keyword (car assoc))) |
| 238 | (insert (symbol-name keyword)) |
| 239 | (finder-insert-at-column 14 (concat (cdr assoc) "\n")) |
| 240 | (finder-mouse-face-on-line))) |
| 241 | finder-known-keywords) |
| 242 | (goto-char (point-min)) |
| 243 | (setq finder-headmark (point)) |
| 244 | (setq buffer-read-only t) |
| 245 | (set-buffer-modified-p nil) |
| 246 | (balance-windows) |
| 247 | (finder-summary))) |
| 248 | |
| 249 | (defun finder-list-matches (key) |
| 250 | (pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*"))) |
| 251 | (finder-mode) |
| 252 | (setq buffer-read-only nil) |
| 253 | (erase-buffer) |
| 254 | (let ((id (intern key))) |
| 255 | (insert |
| 256 | "The following packages match the keyword `" key "':\n\n") |
| 257 | (setq finder-headmark (point)) |
| 258 | (mapc |
| 259 | (lambda (x) |
| 260 | (if (memq id (car (cdr (cdr x)))) |
| 261 | (progn |
| 262 | (insert (car x)) |
| 263 | (finder-insert-at-column 16 (concat (nth 1 x) "\n")) |
| 264 | (finder-mouse-face-on-line)))) |
| 265 | finder-package-info) |
| 266 | (goto-char (point-min)) |
| 267 | (forward-line) |
| 268 | (setq buffer-read-only t) |
| 269 | (set-buffer-modified-p nil) |
| 270 | (shrink-window-if-larger-than-buffer) |
| 271 | (finder-summary))) |
| 272 | |
| 273 | ;;;###autoload |
| 274 | (defun finder-commentary (file) |
| 275 | "Display FILE's commentary section. |
| 276 | FILE should be in a form suitable for passing to `locate-library'." |
| 277 | (interactive |
| 278 | (list |
| 279 | (completing-read "Library name: " |
| 280 | 'locate-file-completion |
| 281 | (cons (or find-function-source-path load-path) |
| 282 | (find-library-suffixes))))) |
| 283 | (let* ((str (lm-commentary (find-library-name file)))) |
| 284 | (if (null str) |
| 285 | (error "Can't find any Commentary section")) |
| 286 | ;; This used to use *Finder* but that would clobber the |
| 287 | ;; directory of categories. |
| 288 | (delete-other-windows) |
| 289 | (pop-to-buffer "*Finder-package*") |
| 290 | (setq buffer-read-only nil) |
| 291 | (erase-buffer) |
| 292 | (insert str) |
| 293 | (goto-char (point-min)) |
| 294 | (delete-blank-lines) |
| 295 | (goto-char (point-max)) |
| 296 | (delete-blank-lines) |
| 297 | (goto-char (point-min)) |
| 298 | (while (re-search-forward "^;+ ?" nil t) |
| 299 | (replace-match "" nil nil)) |
| 300 | (goto-char (point-min)) |
| 301 | (setq buffer-read-only t) |
| 302 | (set-buffer-modified-p nil) |
| 303 | (shrink-window-if-larger-than-buffer) |
| 304 | (finder-mode) |
| 305 | (finder-summary))) |
| 306 | |
| 307 | (defun finder-current-item () |
| 308 | (let ((key (save-excursion |
| 309 | (beginning-of-line) |
| 310 | (current-word)))) |
| 311 | (if (or (and finder-headmark (< (point) finder-headmark)) |
| 312 | (= (length key) 0)) |
| 313 | (error "No keyword or filename on this line") |
| 314 | key))) |
| 315 | |
| 316 | (defun finder-select () |
| 317 | "Select item on current line in a finder buffer." |
| 318 | (interactive) |
| 319 | (let ((key (finder-current-item))) |
| 320 | (if (string-match "\\.el$" key) |
| 321 | (finder-commentary key) |
| 322 | (finder-list-matches key)))) |
| 323 | |
| 324 | (defun finder-mouse-select (event) |
| 325 | "Select item in a finder buffer with the mouse." |
| 326 | (interactive "e") |
| 327 | (save-excursion |
| 328 | (set-buffer (window-buffer (posn-window (event-start event)))) |
| 329 | (goto-char (posn-point (event-start event))) |
| 330 | (finder-select))) |
| 331 | |
| 332 | ;;;###autoload |
| 333 | (defun finder-by-keyword () |
| 334 | "Find packages matching a given keyword." |
| 335 | (interactive) |
| 336 | (finder-list-keywords)) |
| 337 | |
| 338 | (defun finder-mode () |
| 339 | "Major mode for browsing package documentation. |
| 340 | \\<finder-mode-map> |
| 341 | \\[finder-select] more help for the item on the current line |
| 342 | \\[finder-exit] exit Finder mode and kill the Finder buffer." |
| 343 | (interactive) |
| 344 | (kill-all-local-variables) |
| 345 | (use-local-map finder-mode-map) |
| 346 | (set-syntax-table emacs-lisp-mode-syntax-table) |
| 347 | (setq mode-name "Finder") |
| 348 | (setq major-mode 'finder-mode) |
| 349 | (set (make-local-variable 'finder-headmark) nil) |
| 350 | (run-mode-hooks 'finder-mode-hook)) |
| 351 | |
| 352 | (defun finder-summary () |
| 353 | "Summarize basic Finder commands." |
| 354 | (interactive) |
| 355 | (message "%s" |
| 356 | (substitute-command-keys |
| 357 | "\\<finder-mode-map>\\[finder-select] = select, \ |
| 358 | \\[finder-mouse-select] = select, \\[finder-list-keywords] = to \ |
| 359 | finder directory, \\[finder-exit] = quit, \\[finder-summary] = help"))) |
| 360 | |
| 361 | (defun finder-exit () |
| 362 | "Exit Finder mode and kill the buffer." |
| 363 | (interactive) |
| 364 | (or (one-window-p t) |
| 365 | (delete-window)) |
| 366 | ;; Can happen in either buffer -- kill each of the two that exists |
| 367 | (and (get-buffer "*Finder*") |
| 368 | (kill-buffer "*Finder*")) |
| 369 | (and (get-buffer "*Finder Category*") |
| 370 | (kill-buffer "*Finder Category*"))) |
| 371 | |
| 372 | \f |
| 373 | (provide 'finder) |
| 374 | |
| 375 | ;;; arch-tag: ec85ff49-8cb8-41f5-a63f-9131d53ce2c5 |
| 376 | ;;; finder.el ends here |