Mercurial > hg > xemacs-beta
annotate lisp/finder.el @ 5327:d1b17a33450b
Move the heavy lifting from cl-seq.el to C.
src/ChangeLog addition:
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
Move the heavy lifting from cl-seq.el to C, finally making those
functions first-class XEmacs citizens, with circularity checking,
built-in support for tests other than #'eql, and as much
compatibility with current Common Lisp as Paul Dietz' tests require.
* fns.c (check_eq_nokey, check_eq_key, check_eql_nokey)
(check_eql_key, check_equal_nokey, check_equal_key)
(check_equalp_nokey, check_equalp_key, check_string_match_nokey)
(check_string_match_key, check_other_nokey, check_other_key)
(check_if_nokey, check_if_key, check_match_eq_key)
(check_match_eql_key, check_match_equal_key)
(check_match_equalp_key, check_match_other_key): New. These are
basically to provide function pointers to be used by Lisp
functions that take TEST, TEST-NOT and KEY arguments.
(get_check_match_function_1, get_check_test_function)
(get_check_match_function): These functions work out which of the
previous list of functions to use, given the keywords supplied by
the user.
(count_with_tail): New. This is the bones of #'count.
(list_count_from_end, string_count_from_end): Utility functions
for #'count.
(Fcount): New, moved from cl-seq.el.
(list_position_cons_before): New. The implementation of #'member*,
and important in implementing various other functions.
(FmemberX, Fadjoin, FassocX, FrassocX, Fposition, Ffind)
(FdeleteX, FremoveX, Fdelete_duplicates, Fremove_duplicates)
(Fnsubstitute, Fsubstitute, Fsublis, Fnsublis, Fsubst, Fnsubst)
(Ftree_equal, Fmismatch, Fsearch, Fintersection, Fnintersection)
(Fsubsetp, Fset_difference, Fnset_difference, Fnunion, Funion)
(Fset_exclusive_or, Fnset_exclusive_or): New, moved here from
cl-seq.el.
(position): New. The implementation of #'find and #'position.
(list_delete_duplicates_from_end, subst, sublis, nsublis)
(tree_equal, mismatch_from_end, mismatch_list_list)
(mismatch_list_string, mismatch_list_array)
(mismatch_string_array, mismatch_string_string)
(mismatch_array_array, get_mismatch_func): Helper C functions for
the Lisp-visible functions.
(venn, nvenn): New. The implementation of the main Lisp functions that
treat lists as sets.
lisp/ChangeLog addition:
2010-12-30 Aidan Kehoe <kehoea@parhasard.net>
* cl-seq.el:
Move the heavy lifting from this file to C. Dump the
cl-parsing-keywords macro, but don't use defun* for the functions
we define that do take keywords, dynamic scope lossage makes that
not practical.
* subr.el (sort, fillarray): Move these aliases here.
(map-plist): #'nsublis is now built-in, but at this point #'eql
isn't necessarily available as a test; use #'eq.
* obsolete.el (cl-delete-duplicates): Make this available for old
compiler macros and old code.
(memql): Document that this is equivalent to #'member*, and worse.
* cl.el (adjoin, subst): Removed. These are in C.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Thu, 30 Dec 2010 01:59:52 +0000 |
| parents | e29fcfd8df5f |
| children | 308d34e9f07d |
| rev | line source |
|---|---|
| 2984 | 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 ;; X-Modified-by: Bob Weiner <weiner@mot.com>, 4/18/95, to include Lisp | |
| 10 ;; library directory names in finder-program-info, for fast display of | |
| 11 ;; Lisp libraries and associated commentaries. Added {v}, finder-view, | |
| 12 ;; and {e}, finder-edit commands for displaying libraries. | |
| 13 ;; | |
| 14 ;; Added user variable, 'finder-abbreviate-directory-list', used to | |
| 15 ;; abbreviate directories before they are saved to finder-program-info. | |
| 16 ;; Such relative directories can be portable from one Emacs installation | |
| 17 ;; to another. Default value is based upon the value of Emacs' | |
| 18 ;; data-directory variable. | |
| 19 | |
| 20 ;; This file is part of XEmacs. | |
| 21 | |
| 22 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 23 ;; under the terms of the GNU General Public License as published by | |
| 24 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 25 ;; any later version. | |
| 26 | |
| 27 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 28 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 29 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 30 ;; General Public License for more details. | |
| 31 | |
| 32 ;; You should have received a copy of the GNU General Public License | |
| 33 ;; along with XEmacs; see the file COPYING. If not, write to the Free | |
| 34 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA | |
| 35 ;; 02111-1307, USA. | |
| 36 | |
| 37 ;;; Synched up with: FSF 19.34. | |
| 38 | |
| 39 ;;; Commentary: | |
| 40 | |
| 41 ;; This mode uses the Keywords library header to provide code-finding | |
| 42 ;; services by keyword. | |
| 43 ;; | |
| 44 ;; Things to do: | |
| 45 ;; 1. Support multiple keywords per search. This could be extremely hairy; | |
| 46 ;; there doesn't seem to be any way to get completing-read to exit on | |
| 47 ;; an EOL with no substring pending, which is what we'd want to end the loop. | |
| 48 ;; 2. Search by string in synopsis line? | |
| 49 ;; 3. Function to check finder-package-info for unknown keywords. | |
| 50 | |
| 51 ;;; Code: | |
| 52 | |
| 53 (require 'lisp-mnt) | |
| 54 (condition-case nil | |
| 55 (require 'finder-inf) | |
| 56 (t nil)) | |
| 57 ;; XEmacs addition | |
| 58 (require 'picture) | |
| 59 (require 'mode-motion) | |
| 60 | |
| 61 (defvar finder-emacs-root-directory | |
| 62 (file-name-directory (directory-file-name data-directory)) | |
| 63 "Root directory of current emacs tree.") | |
| 64 | |
| 65 (defvar finder-abbreviate-directory-list | |
| 66 (list finder-emacs-root-directory) | |
| 67 "*List of directory roots to remove from finder-package-info directory entries. | |
| 68 The first element in the list is used when expanding relative package | |
| 69 directories to view or extract information from package source code.") | |
| 70 | |
| 71 (defvar finder-file-regexp "\\.el$" | |
| 72 "Regexp which matches file names but not Emacs Lisp finder keywords.") | |
| 73 | |
| 74 ;; Local variable in finder buffer. | |
| 75 (defvar finder-headmark) | |
| 76 | |
| 77 (defvar finder-known-keywords | |
| 78 `( | |
| 79 (abbrev . "abbreviation handling, typing shortcuts, macros") | |
| 80 (bib . "code related to the `bib' bibliography processor") | |
| 81 (build . "code used to build XEmacs") | |
| 82 (c . "C, C++, and Objective-C language support") | |
| 83 (calendar . "calendar and time management support") | |
| 84 (comm . "communications, networking, remote access to files") | |
| 85 (content . "contains content (menu/dialog box descs, text, images, &c)") | |
| 86 (data . "support for editing files of data") | |
| 87 (docs . "support for XEmacs documentation") | |
| 88 (dumped . "files preloaded into XEmacs") | |
| 89 (emulations . "emulations of other editors") | |
| 90 (extensions . "Emacs Lisp language extensions") | |
| 91 (faces . "support for multiple fonts") | |
| 92 (frames . "support for XEmacs frames and window systems") | |
| 93 (games . "games, jokes and amusements") | |
| 94 (gui . "support for menubars, dialog boxes, and other GUI features") | |
| 95 (hardware . "support for interfacing with exotic hardware") | |
| 96 (help . "support for on-line help systems") | |
| 97 (hypermedia . "support for links between text or other media types") | |
| 98 (i18n . "internationalization and alternate character-set support") | |
| 99 (internal . "code implementing core functionality in XEmacs") | |
| 100 (languages . "specialized modes for editing programming languages") | |
| 101 (lisp . "Lisp support, including Emacs Lisp") | |
| 102 (local . "code local to your site") | |
| 103 (mail . "modes for electronic-mail handling") | |
| 104 (maint . "maintenance aids for the Emacs development group") | |
| 105 (matching . "various sorts of searching and matching") | |
| 106 (mouse . "mouse support") | |
| 107 (mswin . "support for anything running on MS Windows") | |
| 108 ,(when (featurep 'mule) | |
| 109 (cons 'mule "multi-language extensions")) | |
| 110 (news . "support for netnews reading and posting") | |
| 111 (oop . "support for object-oriented programming") | |
| 112 (outlines . "support for hierarchical outlining") | |
| 113 (processes . "process, subshell, compilation, and job control support") | |
| 114 (services . "provides services for use by other programs (cf `user')") | |
| 115 (terminals . "support for terminal types") | |
| 116 (tex . "code related to the TeX formatter") | |
| 117 (tools . "programming tools") | |
| 118 (unix . "front-ends/assistants for, or emulators of, UNIX features") | |
| 119 (user . "program interacts directly with the user (cf `services'") | |
| 120 (vms . "support code for vms") | |
| 121 (wp . "word processing") | |
| 122 (www . "support for the Web (WWW, the World Wide Web)") | |
| 123 )) | |
| 124 | |
| 125 (defvar finder-mode-map nil) | |
| 126 (or finder-mode-map | |
| 127 (let ((map (make-sparse-keymap))) | |
| 128 (define-key map " " 'finder-select) | |
| 129 (define-key map "f" 'finder-select) | |
| 130 (define-key map "\C-m" 'finder-select) | |
| 131 ;; XEmacs changes | |
| 132 (define-key map "e" 'finder-edit) | |
| 133 (define-key map "v" 'finder-view) | |
| 134 (define-key map "?" 'finder-summary) | |
| 135 (define-key map "q" 'finder-exit) | |
| 136 (define-key map "d" 'finder-list-keywords) | |
| 137 ;; XEmacs change | |
| 138 (define-key map [button2] 'finder-mouse-select) | |
| 139 (setq finder-mode-map map))) | |
| 140 | |
| 141 | |
| 142 ;;; Code for regenerating the keyword list. | |
| 143 | |
| 144 (defvar finder-package-info nil | |
| 145 "Assoc list mapping file names to description & keyword lists.") | |
| 146 | |
| 147 (defvar finder-compile-keywords-quiet nil | |
| 148 "If non-nil finder-compile-keywords will not print any messages.") | |
| 149 | |
| 150 (defun finder-compile-keywords (&rest dirs) | |
| 151 "Regenerate the keywords association list into the file `finder-inf.el'. | |
| 152 Optional arguments are a list of Emacs Lisp directories to compile from; no | |
| 153 arguments compiles from `load-path'." | |
| 154 (save-excursion | |
| 155 ;; XEmacs change | |
| 156 (find-file (expand-file-name "finder-inf.el" lisp-directory)) | |
| 157 (let ((processed nil) | |
| 158 (directory-abbrev-alist | |
| 159 (append | |
| 160 (mapcar (function (lambda (dir) | |
| 161 (cons (concat "^" (regexp-quote dir)) | |
| 162 ""))) | |
| 163 finder-abbreviate-directory-list) | |
| 164 directory-abbrev-alist)) | |
| 165 (using-load-path)) | |
| 166 (or dirs (setq dirs load-path)) | |
| 167 (setq using-load-path (equal dirs load-path)) | |
| 168 (erase-buffer) | |
| 169 (insert ";;; finder-inf.el --- keyword-to-package mapping\n") | |
| 170 (insert ";; Keywords: help\n") | |
| 171 (insert ";;; Commentary:\n") | |
| 172 (insert ";; Don't edit this file. It's generated by finder.el\n\n") | |
| 173 (insert ";;; Code:\n") | |
| 174 (insert "\n(defconst finder-package-info '(\n") | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2984
diff
changeset
|
175 (mapc |
| 2984 | 176 (lambda (d) |
| 177 (mapcar | |
| 178 (lambda (f) | |
| 179 (when (and (not (member f processed)) (file-readable-p f)) | |
| 180 (let (summary keystart keywords) | |
| 181 (setq processed (cons f processed)) | |
| 182 (if (not finder-compile-keywords-quiet) | |
| 183 (message "Processing %s ..." f)) | |
| 184 (save-excursion | |
| 185 (set-buffer (get-buffer-create "*finder-scratch*")) | |
| 186 (buffer-disable-undo (current-buffer)) | |
| 187 (erase-buffer) | |
| 188 (insert-file-contents (expand-file-name f d)) | |
| 189 (with-trapping-errors | |
| 190 :operation (format "processing %s in finder" f) | |
| 191 :class 'finder | |
| 192 (setq summary (lm-synopsis) | |
| 193 keywords (lm-keywords)))) | |
| 194 (when summary | |
| 195 (insert (format " (\"%s\"\n " f)) | |
| 196 (prin1 summary (current-buffer)) | |
| 197 (insert "\n ") | |
| 198 (setq keystart (point)) | |
| 199 (insert (if keywords (format "(%s)" keywords) "nil")) | |
| 200 (subst-char-in-region keystart (point) ?, ? ) | |
| 201 (insert "\n ") | |
| 202 (prin1 (abbreviate-file-name d) (current-buffer)) | |
| 203 (insert ")\n"))))) | |
| 204 ;; | |
| 205 ;; Skip null, non-existent or relative pathnames, e.g. "./", if | |
| 206 ;; using load-path, so that they do not interfere with a scan of | |
| 207 ;; library directories only. | |
| 208 (if (and using-load-path | |
| 209 (not (and d (file-name-absolute-p d) (file-exists-p d)))) | |
| 210 nil | |
| 211 (setq d (file-name-as-directory (or d "."))) | |
| 212 (directory-files d nil "^[^=].*\\.el$")))) | |
| 213 dirs) | |
| 214 (insert "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n") | |
| 215 (kill-buffer "*finder-scratch*") | |
| 216 (unless noninteractive | |
| 217 (eval-current-buffer)) ; So we get the new keyword list immediately | |
| 218 (basic-save-buffer)))) | |
| 219 | |
| 220 (defun finder-compile-keywords-make-dist () | |
| 221 "Regenerate `finder-inf.el' for the Emacs distribution." | |
| 222 (finder-compile-keywords default-directory)) | |
| 223 | |
| 224 ;;; Now the retrieval code | |
| 225 | |
| 226 (defun finder-insert-at-column (column &rest strings) | |
| 227 "Insert list of STRINGS, at column COLUMN." | |
| 228 (if (>= (current-column) column) (insert "\n")) | |
| 229 (move-to-column column) | |
| 230 (let ((col (current-column))) | |
| 231 (if (< col column) | |
| 232 (indent-to column) | |
| 233 (if (and (/= col column) | |
| 234 (= (preceding-char) ?\t)) | |
| 235 (let (indent-tabs-mode) | |
| 236 (delete-char -1) | |
| 237 (indent-to col) | |
| 238 (move-to-column column))))) | |
| 239 (apply 'insert strings)) | |
| 240 | |
| 241 (defun finder-list-keywords () | |
| 242 "Display descriptions of the keywords in the Finder buffer." | |
| 243 (interactive) | |
| 244 (setq buffer-read-only nil) | |
| 245 (erase-buffer) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2984
diff
changeset
|
246 (mapc |
| 2984 | 247 (lambda (assoc) |
| 248 (let ((keyword (car assoc))) | |
| 249 (insert (symbol-name keyword)) | |
| 250 (finder-insert-at-column 14 (concat (cdr assoc) "\n")) | |
| 251 (cons (symbol-name keyword) keyword))) | |
| 252 finder-known-keywords) | |
| 253 (goto-char (point-min)) | |
| 254 (setq finder-headmark (point)) | |
| 255 (setq buffer-read-only t) | |
| 256 (set-buffer-modified-p nil) | |
| 257 ;; XEmacs change | |
| 258 (if (not (one-window-p)) | |
| 259 (balance-windows)) | |
| 260 (finder-summary)) | |
| 261 | |
| 262 (defun finder-list-matches (key) | |
| 263 (setq buffer-read-only nil) | |
| 264 (erase-buffer) | |
| 265 (let ((id (intern key))) | |
| 266 (insert | |
| 267 "The following packages match the keyword `" key "':\n\n") | |
| 268 (setq finder-headmark (point)) | |
|
4783
e29fcfd8df5f
Eliminate most core code byte-compile warnings.
Aidan Kehoe <kehoea@parhasard.net>
parents:
2984
diff
changeset
|
269 (mapc |
| 2984 | 270 (lambda (x) |
| 271 (if (memq id (car (cdr (cdr x)))) | |
| 272 (progn | |
| 273 (insert (car x)) | |
| 274 (finder-insert-at-column 16 (concat (car (cdr x)) "\n"))))) | |
| 275 finder-package-info) | |
| 276 (goto-char (point-min)) | |
| 277 (forward-line) | |
| 278 (setq buffer-read-only t) | |
| 279 (set-buffer-modified-p nil) | |
| 280 (shrink-window-if-larger-than-buffer) | |
| 281 (finder-summary))) | |
| 282 | |
| 283 ;; Search for a file named FILE the same way `load' would search. | |
| 284 (defun finder-find-library (file) | |
| 285 (if (file-name-absolute-p file) | |
| 286 file | |
| 287 (let ((dirs load-path) | |
| 288 found) | |
| 289 (while (and dirs (not found)) | |
| 290 (if (file-exists-p (expand-file-name (concat file ".el") (car dirs))) | |
| 291 (setq found (expand-file-name (concat file ".el") (car dirs))) | |
| 292 (if (file-exists-p (expand-file-name file (car dirs))) | |
| 293 (setq found (expand-file-name file (car dirs))))) | |
| 294 (setq dirs (cdr dirs))) | |
| 295 found))) | |
| 296 | |
| 297 ;;;###autoload | |
| 298 (defun finder-commentary (file) | |
| 299 "Display FILE's commentary section. | |
| 300 FILE should be in a form suitable for passing to `locate-library'." | |
| 301 (interactive "sLibrary name: ") | |
| 302 (let* ((str (lm-commentary (or (finder-find-library file) | |
| 303 (finder-find-library (concat file ".el")) | |
| 304 (error "Can't find library %s" file))))) | |
| 305 (if (null str) | |
| 306 (error "Can't find any Commentary section")) | |
| 307 (pop-to-buffer "*Finder*") | |
| 308 ;; XEmacs change | |
| 309 (setq buffer-read-only nil | |
| 310 mode-motion-hook 'mode-motion-highlight-line) | |
| 311 (erase-buffer) | |
| 312 (insert str) | |
| 313 (goto-char (point-min)) | |
| 314 (delete-blank-lines) | |
| 315 (goto-char (point-max)) | |
| 316 (delete-blank-lines) | |
| 317 (goto-char (point-min)) | |
| 318 (while (re-search-forward "^;+ ?" nil t) | |
| 319 (replace-match "" nil nil)) | |
| 320 (goto-char (point-min)) | |
| 321 (setq buffer-read-only t) | |
| 322 (set-buffer-modified-p nil) | |
| 323 (shrink-window-if-larger-than-buffer) | |
| 324 (finder-summary))) | |
| 325 | |
| 326 (defun finder-current-item () | |
| 327 (if (and finder-headmark (< (point) finder-headmark)) | |
| 328 (error "No keyword or filename on this line") | |
| 329 (save-excursion | |
| 330 (beginning-of-line) | |
| 331 (current-word)))) | |
| 332 | |
| 333 ;; XEmacs change | |
| 334 (defun finder-edit () | |
| 335 (interactive) | |
| 336 (let ((entry (finder-current-item))) | |
| 337 (if (string-match finder-file-regexp entry) | |
| 338 (let ((path (finder-find-library entry))) | |
| 339 (if path | |
| 340 (find-file-other-window path) | |
| 341 (error "Can't find Emacs Lisp library: '%s'" entry))) | |
| 342 ;; a finder keyword | |
| 343 (error "Finder-edit works on Emacs Lisp libraries only")))) | |
| 344 | |
| 345 ;; XEmacs change | |
| 346 (defun finder-view () | |
| 347 (interactive) | |
| 348 (let ((entry (finder-current-item))) | |
| 349 (if (string-match finder-file-regexp entry) | |
| 350 (let ((path (finder-find-library entry))) | |
| 351 (if path | |
| 352 (view-file-other-window path) | |
| 353 (error "Can't find Emacs Lisp library: '%s'" entry))) | |
| 354 ;; a finder keyword | |
| 355 (error "Finder-view works on Emacs Lisp libraries only")))) | |
| 356 | |
| 357 (defun finder-select () | |
| 358 (interactive) | |
| 359 (let ((key (finder-current-item))) | |
| 360 ;; XEmacs change | |
| 361 (if (string-match finder-file-regexp key) | |
| 362 (finder-commentary key) | |
| 363 (finder-list-matches key)))) | |
| 364 | |
| 365 ;; XEmacs change | |
| 366 (defun finder-mouse-select (ev) | |
| 367 (interactive "e") | |
| 368 (goto-char (event-point ev)) | |
| 369 (finder-select)) | |
| 370 | |
| 371 ;; XEmacs change | |
| 372 ;;;###autoload | |
| 373 (defun finder-by-keyword () | |
| 374 "Find packages matching a given keyword." | |
| 375 (interactive) | |
| 376 (finder-mode) | |
| 377 (finder-list-keywords)) | |
| 378 | |
| 379 (defun finder-mode () | |
| 380 "Major mode for browsing package documentation. | |
| 381 \\<finder-mode-map> | |
| 382 \\[finder-select] more help for the item on the current line | |
| 383 \\[finder-edit] edit Lisp library in another window | |
| 384 \\[finder-view] view Lisp library in another window | |
| 385 \\[finder-exit] exit Finder mode and kill the Finder buffer. | |
| 386 " | |
| 387 (interactive) | |
| 388 (pop-to-buffer "*Finder*") | |
| 389 ;; XEmacs change | |
| 390 (setq buffer-read-only nil | |
| 391 mode-motion-hook 'mode-motion-highlight-line) | |
| 392 (erase-buffer) | |
| 393 (use-local-map finder-mode-map) | |
| 394 (set-syntax-table emacs-lisp-mode-syntax-table) | |
| 395 (setq mode-name "Finder") | |
| 396 (setq major-mode 'finder-mode) | |
| 397 (make-local-variable 'finder-headmark) | |
| 398 (setq finder-headmark nil)) | |
| 399 | |
| 400 (defun finder-summary () | |
| 401 "Summarize basic Finder commands." | |
| 402 (interactive) | |
| 403 (message "%s" | |
| 404 (substitute-command-keys | |
| 405 ;; XEmacs change | |
| 406 "\\<finder-mode-map>\\[finder-select] = select, \\[finder-list-keywords] = keywords, \\[finder-edit] = edit, \\[finder-view] = view, \\[finder-exit] = quit, \\[finder-summary] = help"))) | |
| 407 | |
| 408 (defun finder-exit () | |
| 409 "Exit Finder mode and kill the buffer." | |
| 410 (interactive) | |
| 411 ;; XEmacs change | |
| 412 (or (one-window-p t 0) | |
| 413 (delete-window)) | |
| 414 (kill-buffer "*Finder*")) | |
| 415 | |
| 416 (provide 'finder) | |
| 417 | |
| 418 ;;; finder.el ends here |