mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-31 11:13:50 +00:00
Code Issues Releases Activity

(finder-compile-keywords) Treat nil in a path argument as $PWD.

Browse Source 
(finder-by-keyword) Handle LFD as input gracefully.
This commit is contained in:
Eric S. Raymond 1993-03-17 14:26:35 +00:00
parent d629242872
commit c5d87135f5
1 changed files with 59 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

110
lisp/finder.el
View File

@ -79,42 +79,46 @@
Optional arguments are a list of Emacs Lisp directories to compile from; no
arguments compiles from `load-path'."
(save-excursion
(find-file "finder-inf.el")
(erase-buffer)
(insert ";;; Don't edit this file. It's generated by finder.el\n\n")
(insert "\n(setq finder-package-info '(\n")
(mapcar
(function (lambda (d)
(mapcar
(function (lambda (f)
(if (string-match "\\.el$" f)
(let (summary keystart)
(save-excursion
(set-buffer (get-buffer-create "*finder-scratch*"))
(erase-buffer)
(insert-file-contents
(concat (file-name-as-directory d) f))
(setq summary (lm-synopsis))
(setq keywords (lm-keywords)))
(insert
(format " (\"%s\"\n " 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 ".")))
))
(or dirs load-path))
(insert "))\n\n(provide 'finder-inf)\n")
(kill-buffer "*finder-scratch*")
(basic-save-buffer)
))
(let ((processed nil))
(find-file "finder-inf.el")
(erase-buffer)
(insert ";;; Don't edit this file. It's generated by finder.el\n\n")
(insert "\n(setq finder-package-info '(\n")
(mapcar
(function
(lambda (d)
(mapcar
(function
(lambda (f)
(if (and (string-match "\\.el$" f) (not (member f processed)))
(let (summary keystart)
(setq processed (cons f processed))
(save-excursion
(set-buffer (get-buffer-create "*finder-scratch*"))
(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 " 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 ".")))
))
(or dirs load-path))
(insert "))\n\n(provide 'finder-inf)\n")
(kill-buffer "*finder-scratch*")
(basic-save-buffer)
)))
;;; Now the retrieval code
@ -132,25 +136,29 @@ arguments compiles from `load-path'."
(goto-char (point-min))
(let (key
(known (mapcar (function (lambda (x) (car x))) finder-known-keywords)))
(let ((key (intern (completing-read
(let ((key (completing-read
"Package keyword: "
(vconcat known)
(function (lambda (arg) (memq arg known)))
t))))
t))
id)
(erase-buffer)
(insert
"The following packages match the keyword `" (symbol-name key) "':\n\n")
(mapcar
(function (lambda (x)
(if (memq key (car (cdr (cdr x))))
(progn
(insert (car x))
(insert-at-column 16 (car (cdr x)) "\n")
))
))
finder-package-info)
(goto-char (point-min))
)))
(if (equal key "")
(delete-window (get-buffer-window "*Help*"))
(setq id (intern key))
(insert
"The following packages match the keyword `" key "':\n\n")
(mapcar
(function (lambda (x)
(if (memq id (car (cdr (cdr x))))
(progn
(insert (car x))
(insert-at-column 16 (car (cdr x)) "\n")
))
))
finder-package-info)
(goto-char (point-min))
))))
(provide 'finder)