code.delx.au - gnu-emacs/blob - lisp/finder.el

   1 ;;; finder.el --- topic & keyword-based code finder
   2
   3 ;; Copyright (C) 1992 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 1, or (at your option)
  15 ;; 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; see the file COPYING.  If not, write to
  24 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  25
  26 ;; Commentary:
  27
  28 ;; This mode uses the Keywords library header to provide code-finding
  29 ;; services by keyword.
  30 ;;
  31 ;; Things to do:
  32 ;;    1. Support multiple keywords per search.  This could be extremely hairy;
  33 ;; there doesn't seem to be any way to get completing-read to exit on
  34 ;; an EOL with no substring pending, which is what we'd want to end the loop.
  35 ;;    2. Search by string in synopsis line?
  36 ;;    3. Function to check finder-package-info for unknown keywords.
  37
  38 ;;; Code:
  39
  40 (require 'lisp-mnt)
  41 (require 'finder-inf)
  42 (require 'picture)
  43
  44 (defvar finder-known-keywords
  45   '(
  46     (abbrev     . "abbreviation handling, typing shortcuts, macros")
  47     (bib        . "code related to the bib(1) bibliography processor")
  48     (c          . "C and C++ language support")
  49     (calendar   . "calendar and time management support")
  50     (comm       . "communications, networking, remote access to files")
  51     (docs       . "support for Emacs documentation")
  52     (emulations . "emulations of other editors")
  53     (extensions . "Emacs Lisp language extensions")
  54     (games      . "games, jokes and amusements")
  55     (hardware   . "support for interfacing with exotic hardware")
  56     (help       . "support for on-line help systems")
  57     (i14n       . "internationalization and alternate 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      . "maintenance aids for the Emacs development group")
  63     (mail       . "modes for electronic-mail handling")
  64     (news       . "support for netnews reading and posting")
  65     (processes  . "process, subshell, compilation, and job control support")
  66     (terminals  . "support for terminal types")
  67     (tex        . "code related to the TeX formatter")
  68     (tools      . "programming tools")
  69     (unix       . "front-ends/assistants for, or emulators of, UNIX features")
  70     (vms        . "support code for vms")
  71     (wp         . "word processing")
  72     ))
  73
  74 ;;; Code for regenerating the keyword list.
  75
  76 (defvar finder-package-info nil
  77   "Assoc list mapping file names to description & keyword lists.")
  78
  79 (defun finder-compile-keywords (&rest dirs)
  80   "Regenerate the keywords association list into the file finder-inf.el.
  81 Optional arguments are a list of Emacs Lisp directories to compile from; no
  82 arguments compiles from `load-path'."
  83   (save-excursion
  84     (let ((processed nil))
  85       (find-file "finder-inf.el")
  86       (erase-buffer)
  87       (insert ";;; finder-inf.el --- keyword-to-package mapping\n")
  88       (insert ";; Keywords: help\n")
  89       (insert ";;; Commentary:\n")
  90       (insert ";; Don't edit this file.  It's generated by finder.el\n\n")
  91       (insert ";;; Code:\n")
  92       (insert "\n(setq finder-package-info '(\n")
  93       (mapcar
  94        (function
  95         (lambda (d)
  96           (mapcar
  97            (function
  98             (lambda (f)
  99               (if (and (string-match "\\.el$" f) (not (member f processed)))
 100                   (let (summary keystart)
 101                     (setq processed (cons f processed))
 102                     (save-excursion
 103                       (set-buffer (get-buffer-create "*finder-scratch*"))
 104                       (erase-buffer)
 105                       (insert-file-contents
 106                        (concat (file-name-as-directory (or d ".")) f))
 107                       (setq summary (lm-synopsis))
 108                       (setq keywords (lm-keywords)))
 109                     (insert
 110                      (format "    (\"%s\"\n        " f))
 111                     (prin1 summary (current-buffer))
 112                     (insert
 113                      "\n        ")
 114                     (setq keystart (point))
 115                     (insert
 116                      (if keywords (format "(%s)" keywords) "nil")
 117                      ")\n")
 118                     (subst-char-in-region keystart (point) ?, ? )
 119                     )
 120                 )))
 121            (directory-files (or d ".")))
 122           ))
 123        (or dirs load-path))
 124       (insert "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n")
 125       (kill-buffer "*finder-scratch*")
 126       (eval-current-buffer) ;; So we get the new keyword list immediately
 127       (basic-save-buffer)
 128       )))
 129
 130 ;;; Now the retrieval code
 131
 132 (defun finder-by-keyword ()
 133   "Find packages matching a given keyword."
 134   (interactive)
 135   (pop-to-buffer "*Help*")
 136   (erase-buffer)
 137   (mapcar
 138    (function (lambda (x)
 139                (insert (symbol-name (car x)))
 140                (insert-at-column 14 (cdr x) "\n")
 141                ))
 142    finder-known-keywords)
 143   (goto-char (point-min))
 144   (let (key
 145         (known (mapcar (function (lambda (x) (car x))) finder-known-keywords)))
 146     (let ((key (completing-read
 147                 "Package keyword: "
 148                 (vconcat known)
 149                 (function (lambda (arg) (memq arg known)))
 150                 t))
 151           id)
 152       (erase-buffer)
 153       (if (equal key "")
 154           (delete-window (get-buffer-window "*Help*"))
 155         (setq id (intern key))
 156         (insert
 157          "The following packages match the keyword `" key "':\n\n")
 158         (mapcar
 159          (function (lambda (x)
 160                      (if (memq id (car (cdr (cdr x))))
 161                          (progn
 162                            (insert (car x))
 163                            (insert-at-column 16 (car (cdr x)) "\n")
 164                            ))
 165                      ))
 166          finder-package-info)
 167         (goto-char (point-min))
 168         ))))
 169
 170 (provide 'finder)
 171
 172 ;;; finder.el ends here