1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-01 11:14:55 +00:00

(finder-headmark): Initialize and add doc string.

(generated-finder-keywords-file): Doc fix.
(finder-no-scan-regexp): New variable.
(finder-compile-keywords): Use a single let binding.  Disable undo in
the output buffer.  Use autoload-rubric.  Use mapc rather than mapcar.
Don't scan files matching finder-no-scan-regexp.  Use
with-temp-buffer.  Use expand-file-name rather than concat.  Use
directory-files to do regexp matching.  No need to require jka-compr.
(finder-list-keywords): Remove un-needed set-buffer.  Disable undo.
(finder-list-matches): Disable undo.
(finder-commentary): Use let rather than let*.  Disable undo.
(finder-current-item): Use zerop.
(finder-mode): Use define-derived-mode.
(finder-exit): Doc fix.  Use dolist.
This commit is contained in:
Glenn Morris 2008-06-05 02:35:15 +00:00
parent 7b75374407
commit 228b739631

View File

@ -1,7 +1,7 @@
;;; finder.el --- topic & keyword-based code finder
;; Copyright (C) 1992, 1997, 1998, 1999, 2001, 2002, 2003,
;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Copyright (C) 1992, 1997, 1998, 1999, 2001, 2002, 2003, 2004, 2005,
;; 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
;; Created: 16 Jun 1992
@ -43,12 +43,6 @@
;; during byte-compilation (at which point it might be missing).
(load "finder-inf" t t)
(defvar finder-mode-hook nil
"*Hook run when function `finder-mode' is called.")
;; Local variable in finder buffer.
(defvar finder-headmark)
;; These are supposed to correspond to top-level customization groups,
;; says rms.
(defvar finder-known-keywords
@ -118,6 +112,8 @@
'(("`\\([^']+\\)'" 1 font-lock-constant-face prepend))
"Font-lock keywords for Finder mode.")
(defvar finder-headmark nil
"Internal finder-mode variable, local in finder buffer.")
;;; Code for regenerating the keyword list.
@ -125,76 +121,65 @@
"Assoc list mapping file names to description & keyword lists.")
(defvar generated-finder-keywords-file "finder-inf.el"
"File \\[finder-compile-keywords] puts finder keywords into.")
"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.
;; http://lists.gnu.org/archive/html/emacs-pretest-bug/2007-01/msg00469.html
(defvar finder-no-scan-regexp "\\(^\\.#\\|\\(loaddefs\\|cus-load\\|\
finder-inf\\|esh-groups\\|subdirs\\)\\.el$\\)"
"Regexp matching file names not to scan for keywords.")
(autoload 'autoload-rubric "autoload")
(defun finder-compile-keywords (&rest dirs)
"Regenerate the keywords association list into `generated-finder-keywords-file'.
Optional arguments DIRS are a list of Emacs Lisp directories to compile from;
no arguments compiles from `load-path'."
(save-excursion
(let ((processed nil))
(let (processed summary keystart keywords)
(find-file generated-finder-keywords-file)
(setq buffer-undo-list t)
(erase-buffer)
(insert ";;; " (file-name-nondirectory generated-finder-keywords-file)
" --- keyword-to-package mapping\n")
(insert ";; This file is part of GNU Emacs.\n")
(insert ";;; Commentary:\n")
(insert ";; Don't edit this file. It's generated by finder.el\n\n")
(insert ";;; Code:\n")
(insert (autoload-rubric generated-finder-keywords-file
"keyword-to-package mapping"))
(search-backward " ")
(insert "\n(setq finder-package-info '(\n")
(mapc
(lambda (d)
(when (file-exists-p (directory-file-name d))
(message "Directory %s" d)
(mapcar
(mapc
(lambda (f)
(if (and (or (string-match "^[^=].*\\.el$" f)
;; Allow compressed files also. Fixme:
;; generalize this, especially for
;; MS-DOG-type filenames.
(and (string-match "^[^=].*\\.el\\.\\(gz\\|Z\\)$" f)
(require 'jka-compr)))
;; Ignore lock files.
(not (string-match "^.#" f))
(not (member f processed)))
(let (summary keystart keywords)
(setq processed (cons f processed))
(save-excursion
(set-buffer (get-buffer-create "*finder-scratch*"))
(buffer-disable-undo (current-buffer))
(erase-buffer)
(insert-file-contents
(concat (file-name-as-directory (or d ".")) f))
(setq summary (lm-synopsis))
(setq keywords (lm-keywords)))
(insert
(format " (\"%s\"\n "
(if (string-match "\\.\\(gz\\|Z\\)$" f)
(file-name-sans-extension f)
f)))
(prin1 summary (current-buffer))
(insert
"\n ")
(setq keystart (point))
(insert
(if keywords (format "(%s)" keywords) "nil")
")\n")
(subst-char-in-region keystart (point) ?, ? )
)))
(directory-files (or d ".")))))
;; FIXME should this not be using (expand-file-name f d)?
(unless (or (member f processed)
(string-match finder-no-scan-regexp f))
(setq processed (cons f processed))
(with-temp-buffer
(insert-file-contents (expand-file-name f d))
(setq summary (lm-synopsis)
keywords (lm-keywords)))
(insert
(format " (\"%s\"\n "
(if (string-match "\\.\\(gz\\|Z\\)$" f)
(file-name-sans-extension f)
f)))
(prin1 summary (current-buffer))
(insert "\n ")
(setq keystart (point))
(insert (if keywords (format "(%s)" keywords) "nil")
")\n")
(subst-char-in-region keystart (point) ?, ? )))
(directory-files d nil
;; Allow compressed files also. FIXME:
;; generalize this, especially for
;; MS-DOG-type filenames.
"^[^=].*\\.el\\(\\.\\(gz\\|Z\\)\\)?$"
))))
(or dirs load-path))
(insert "))\n
\(provide '" (file-name-sans-extension
(file-name-nondirectory generated-finder-keywords-file)) ")
;; Local Variables:
;; version-control: never
;; no-byte-compile: t
;; no-update-autoloads: t
;; End:
\;;; " (file-name-nondirectory generated-finder-keywords-file) " ends here\n")
(kill-buffer "*finder-scratch*")
(eval-buffer) ;; So we get the new keyword list immediately
(insert "))\n")
(eval-buffer) ; so we get the new keyword list immediately
(basic-save-buffer))))
(defun finder-compile-keywords-make-dist ()
@ -236,9 +221,10 @@ no arguments compiles from `load-path'."
(interactive)
(if (get-buffer "*Finder*")
(pop-to-buffer "*Finder*")
(pop-to-buffer (set-buffer (get-buffer-create "*Finder*")))
(pop-to-buffer (get-buffer-create "*Finder*"))
(finder-mode)
(setq buffer-read-only nil)
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
(mapc
(lambda (assoc)
@ -248,8 +234,8 @@ no arguments compiles from `load-path'."
(finder-mouse-face-on-line)))
finder-known-keywords)
(goto-char (point-min))
(setq finder-headmark (point))
(setq buffer-read-only t)
(setq finder-headmark (point)
buffer-read-only t)
(set-buffer-modified-p nil)
(balance-windows)
(finder-summary)))
@ -257,7 +243,8 @@ no arguments compiles from `load-path'."
(defun finder-list-matches (key)
(pop-to-buffer (set-buffer (get-buffer-create "*Finder Category*")))
(finder-mode)
(setq buffer-read-only nil)
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
(let ((id (intern key)))
(insert
@ -288,14 +275,14 @@ FILE should be in a form suitable for passing to `locate-library'."
(apply-partially 'locate-file-completion-table
(or find-function-source-path load-path)
(find-library-suffixes)))))
(let* ((str (lm-commentary (find-library-name file))))
(if (null str)
(error "Can't find any Commentary section"))
(let ((str (lm-commentary (find-library-name file))))
(or str (error "Can't find any Commentary section"))
;; This used to use *Finder* but that would clobber the
;; directory of categories.
(delete-other-windows)
(pop-to-buffer "*Finder-package*")
(setq buffer-read-only nil)
(setq buffer-read-only nil
buffer-undo-list t)
(erase-buffer)
(insert str)
(goto-char (point-min))
@ -317,7 +304,7 @@ FILE should be in a form suitable for passing to `locate-library'."
(beginning-of-line)
(current-word))))
(if (or (and finder-headmark (< (point) finder-headmark))
(= (length key) 0))
(zerop (length key)))
(error "No keyword or filename on this line")
key)))
@ -343,21 +330,15 @@ FILE should be in a form suitable for passing to `locate-library'."
(interactive)
(finder-list-keywords))
(defun finder-mode ()
(define-derived-mode finder-mode nil "Finder"
"Major mode for browsing package documentation.
\\<finder-mode-map>
\\[finder-select] more help for the item on the current line
\\[finder-exit] exit Finder mode and kill the Finder buffer."
(interactive)
(kill-all-local-variables)
(use-local-map finder-mode-map)
(set-syntax-table finder-mode-syntax-table)
:syntax-table finder-mode-syntax-table
(setq font-lock-defaults '(finder-font-lock-keywords nil nil
(("+-*/.<>=!?$%_&~^:@" . "w")) nil))
(setq mode-name "Finder")
(setq major-mode 'finder-mode)
(set (make-local-variable 'finder-headmark) nil)
(run-mode-hooks 'finder-mode-hook))
(set (make-local-variable 'finder-headmark) nil))
(defun finder-summary ()
"Summarize basic Finder commands."
@ -370,12 +351,11 @@ finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
(defun finder-exit ()
"Exit Finder mode.
Delete the window and kill the buffer."
Delete the window and kill all Finder-related buffers."
(interactive)
(condition-case nil (delete-window) (error nil))
(when (get-buffer "*Finder*") (kill-buffer "*Finder*"))
(when (get-buffer "*Finder-package*") (kill-buffer "*Finder-package*"))
(when (get-buffer "*Finder Category*") (kill-buffer "*Finder Category*")))
(ignore-errors (delete-window))
(dolist (buff '("*Finder*" "*Finder-package*" "*Finder Category*"))
(and (get-buffer buff) (kill-buffer buff))))
(provide 'finder)