Mercurial > hg > xemacs-beta
annotate lisp/lib-complete.el @ 5753:dbd8305e13cb
Warn about non-string non-integer ARG to #'gensym, bytecomp.el.
lisp/ChangeLog addition:
2013-08-21 Aidan Kehoe <kehoea@parhasard.net>
* bytecomp.el:
* bytecomp.el (gensym):
* bytecomp.el (byte-compile-gensym): New.
Warn that gensym called in a for-effect context is unlikely to be
useful.
Warn about non-string non-integer ARGs, this is incorrect.
Am not changing the function to error with same, most code that
makes the mistake is has no problems, which is why it has survived
so long.
* window-xemacs.el (save-window-excursion/mapping):
* window.el (save-window-excursion):
Call #'gensym with a string, not a symbol.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Wed, 21 Aug 2013 19:02:59 +0100 |
| parents | b7ae5f44b950 |
| children |
| rev | line source |
|---|---|
| 428 | 1 ;;; lib-complete.el --- Completion on the lisp search path |
| 2 | |
| 3 ;; Copyright (C) 1997 Free Software Foundation, Inc. | |
| 1123 | 4 ;; Copyright (C) 1991 Mike Williams <mike-w@cs.aukuni.ac.nz>. |
| 5 ;; Copyright (C) 2002 Ben Wing. | |
| 428 | 6 |
| 7 ;; Author: Mike Williams <mike-w@cs.aukuni.ac.nz> | |
| 8 ;; Maintainer: XEmacs Development Team | |
| 9 ;; Keywords: lisp, extensions, dumped | |
| 10 ;; Created: Sat Apr 20 17:47:21 1991 | |
| 11 | |
| 12 ;; This file is part of XEmacs. | |
| 13 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
14 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
15 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
16 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
17 ;; option) any later version. |
| 428 | 18 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
19 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
20 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
21 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
22 ;; for more details. |
| 428 | 23 |
| 24 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
1123
diff
changeset
|
25 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 428 | 26 |
| 27 ;;; Synched up with: Not in FSF. | |
| 28 | |
| 29 ;;; Commentary: | |
| 30 | |
| 31 ;; This file is dumped with XEmacs. | |
| 32 | |
| 33 ;; Many thanks to Hallvard Furuseth <hallvard@ifi.uio.no> for his | |
| 34 ;; helpful suggestions. | |
| 35 | |
| 36 ;;; ChangeLog: | |
| 37 | |
| 38 ;; 4/26/97: sb Mule-ize. | |
| 39 ;; 6/24/1999 much rewriting from Bob Weiner | |
| 40 | |
| 41 ;;; Code: | |
| 42 | |
| 43 ;;=== Determine completions for filename in search path =================== | |
| 44 | |
| 45 (defun library-all-completions (FILE SEARCH-PATH &optional FULL FAST) | |
| 46 "Return all completions for FILE in any directory on SEARCH-PATH. | |
| 47 If optional third argument FULL is non-nil, returned pathnames should be | |
| 48 absolute rather than relative to some directory on the SEARCH-PATH. | |
| 49 If optional fourth argument FAST is non-nil, don't sort the completions, | |
| 50 or remove duplicates." | |
| 51 (setq FILE (or FILE "")) | |
| 52 (if (file-name-absolute-p FILE) | |
| 53 ;; It's an absolute file name, so don't need SEARCH-PATH | |
| 54 (progn | |
| 55 (setq FILE (expand-file-name FILE)) | |
| 56 (file-name-all-completions | |
| 57 (file-name-nondirectory FILE) (file-name-directory FILE))) | |
| 58 (let ((subdir (file-name-directory FILE)) | |
| 59 (file (file-name-nondirectory FILE)) | |
| 60 all-completions) | |
| 61 ;; Make list of completions in each directory on SEARCH-PATH | |
| 62 (while SEARCH-PATH | |
| 63 (let* ((dir (concat (file-name-as-directory | |
| 64 (expand-file-name (car SEARCH-PATH))) | |
| 65 subdir)) | |
| 66 (dir-prefix (if FULL dir subdir))) | |
| 67 (if (file-directory-p dir) | |
| 68 (let ((subdir-completions | |
| 69 (file-name-all-completions file dir))) | |
| 70 (while subdir-completions | |
| 71 (setq all-completions | |
| 72 (cons (concat dir-prefix (car subdir-completions)) | |
| 73 all-completions)) | |
| 74 (setq subdir-completions (cdr subdir-completions)))))) | |
| 75 (setq SEARCH-PATH (cdr SEARCH-PATH))) | |
| 76 (if FAST all-completions | |
| 77 (let ((sorted (nreverse (sort all-completions 'string<))) | |
| 78 compressed) | |
| 79 (while sorted | |
| 80 (if (equal (car sorted) (car compressed)) nil | |
| 81 (setq compressed (cons (car sorted) compressed))) | |
| 82 (setq sorted (cdr sorted))) | |
| 83 compressed))))) | |
| 84 | |
| 85 ;;=== Utilities =========================================================== | |
| 86 | |
| 87 (defmacro progn-with-message (message &rest forms) | |
| 88 "(progn-with-message MESSAGE FORMS ...) | |
| 89 Display MESSAGE and evaluate FORMS, returning value of the last one." | |
| 90 ;; based on Hallvard Furuseth's funcall-with-message | |
| 91 `(if (eq (selected-window) (minibuffer-window)) | |
| 92 (save-excursion | |
| 93 (goto-char (point-max)) | |
| 94 (let ((orig-pmax (point-max))) | |
| 95 (unwind-protect | |
| 96 (progn | |
| 97 (insert " " ,message) (goto-char orig-pmax) | |
| 98 (sit-for 0) ; Redisplay | |
| 99 ,@forms) | |
| 100 (delete-region orig-pmax (point-max))))) | |
| 101 (prog2 | |
| 102 (message "%s" ,message) | |
| 103 (progn ,@forms) | |
| 104 (message "")))) | |
| 105 | |
| 106 (put 'progn-with-message 'lisp-indent-hook 1) | |
| 107 | |
| 108 ;;=== Completion caching ================================================== | |
| 109 | |
| 110 (defconst lib-complete:cache nil | |
| 444 | 111 "Used within `read-library' and `read-library-internal' to prevent |
| 112 costly repeated calls to `library-all-completions'. | |
| 428 | 113 Format is a list of lists of the form |
| 114 | |
| 115 ([<path> <subdir>] <cache-record> <cache-record> ...) | |
| 116 | |
| 117 where each <cache-record> has the form | |
| 118 | |
| 119 (<root> <modtimes> <completion-table>)") | |
| 120 | |
| 121 (defvar lib-complete:max-cache-size 40 | |
| 122 "*Maximum number of search paths which are cached.") | |
| 123 | |
| 124 ;;=== Read a filename, with completion in a search path =================== | |
| 125 | |
| 126 (defun read-library-internal (FILE FILTER FLAG) | |
| 127 "Don't call this." | |
| 128 ;; Relies on read-library-internal-search-path being let-bound | |
| 502 | 129 (declare (special read-library-internal-search-path)) |
|
5655
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
130 (labels |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
131 ((lib-complete:better-root (ROOT1 ROOT2) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
132 ; Return non-nil if ROOT1 is a superset of ROOT2. |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
133 (and (equal (file-name-directory ROOT1) (file-name-directory ROOT2)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
134 (string-match |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
135 (concat "^" (regexp-quote (file-name-nondirectory ROOT1))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
136 ROOT2))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
137 (lib-complete:get-completion-table (FILE PATH FILTER) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
138 (let* ((subdir (file-name-directory FILE)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
139 (root (file-name-nondirectory FILE)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
140 (PATH |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
141 (mapcar |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
142 (function (lambda (dir) (file-name-as-directory |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
143 (expand-file-name (or dir ""))))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
144 PATH)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
145 (key (vector PATH subdir FILTER)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
146 (real-dirs |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
147 (if subdir |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
148 (mapcar (function (lambda (dir) (concat dir subdir))) PATH) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
149 PATH)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
150 (path-modtimes |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
151 (mapcar |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
152 (function (lambda (fn) (if fn (nth 5 (file-attributes fn))))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
153 real-dirs)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
154 (cache-entry (assoc key lib-complete:cache)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
155 (cache-records (cdr cache-entry))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
156 ;; Look for cached entry |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
157 (catch 'table |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
158 (while cache-records |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
159 (if (and |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
160 (lib-complete:better-root (nth 0 (car cache-records)) root) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
161 (equal (nth 1 (car cache-records)) path-modtimes)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
162 (throw 'table (nth 2 (car cache-records)))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
163 (setq cache-records (cdr cache-records))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
164 ;; Otherwise build completions |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
165 (let ((completion-list |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
166 (progn-with-message "(building completion table...)" |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
167 (library-all-completions FILE PATH nil 'fast))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
168 (completion-table (make-vector 127 0))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
169 (while completion-list |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
170 (let ((completion |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
171 (if (or (not FILTER) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
172 (file-directory-p (car completion-list))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
173 (car completion-list) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
174 (funcall FILTER (car completion-list))))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
175 (if completion |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
176 (intern completion completion-table))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
177 (setq completion-list (cdr completion-list))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
178 ;; Cache the completions |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
179 (lib-complete:cache-completions key root |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
180 path-modtimes completion-table) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
181 completion-table)))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
182 (lib-complete:cache-completions (key root modtimes table) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
183 (let* ((cache-entry (assoc key lib-complete:cache)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
184 (cache-records (cdr cache-entry)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
185 (new-cache-records (list (list root modtimes table)))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
186 (if (not cache-entry) nil |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
187 ;; Remove old cache entry |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
188 (setq lib-complete:cache (delete* cache-entry lib-complete:cache)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
189 ;; Copy non-redundant entries from old cache entry |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
190 (while cache-records |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
191 (if (or (equal root (nth 0 (car cache-records))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
192 (lib-complete:better-root root |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
193 (nth 0 (car cache-records)))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
194 nil |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
195 (setq new-cache-records |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
196 (cons (car cache-records) new-cache-records))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
197 (setq cache-records (cdr cache-records)))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
198 ;; Add entry to front of cache |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
199 (setq lib-complete:cache |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
200 (cons (cons key (nreverse new-cache-records)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
201 lib-complete:cache)) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
202 ;; Trim cache |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
203 (let ((tail (nthcdr lib-complete:max-cache-size lib-complete:cache))) |
|
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
204 (if tail (setcdr tail nil)))))) |
| 428 | 205 (let ((completion-table |
| 206 (lib-complete:get-completion-table | |
| 207 FILE read-library-internal-search-path FILTER))) | |
| 208 (cond | |
| 209 ((not completion-table) nil) | |
| 210 ;; Completion table is filtered before use, so the PREDICATE | |
| 211 ;; argument is redundant. | |
| 212 ((eq FLAG nil) (try-completion FILE completion-table nil)) | |
| 213 ((eq FLAG t) (all-completions FILE completion-table nil)) | |
| 214 ((eq FLAG 'lambda) (and (intern-soft FILE completion-table) t)) | |
|
5655
b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
Aidan Kehoe <kehoea@parhasard.net>
parents:
5652
diff
changeset
|
215 )))) |
| 428 | 216 |
| 217 (defun read-library (PROMPT SEARCH-PATH &optional DEFAULT MUST-MATCH | |
| 218 FULL FILTER) | |
| 219 "Read library name, prompting with PROMPT and completing in directories | |
| 220 from SEARCH-PATH. A nil in the search path represents the current | |
| 221 directory. Completions for a given search-path are cached, with the | |
| 222 cache being invalidated whenever one of the directories on the path changes. | |
| 223 Default to DEFAULT if user enters a null string. | |
| 224 Optional fourth arg MUST-MATCH non-nil means require existing file's name. | |
| 225 Non-nil and non-t means also require confirmation after completion. | |
| 226 Optional fifth argument FULL non-nil causes a full pathname, rather than a | |
| 227 relative pathname, to be returned. Note that FULL implies MUST-MATCH. | |
| 228 Optional sixth argument FILTER can be used to provide a function to | |
| 229 filter the completions. This function is passed the filename, and should | |
| 230 return a transformed filename (possibly a null transformation) or nil, | |
| 231 indicating that the filename should not be included in the completions." | |
| 502 | 232 (declare (special read-library-internal-search-path)) |
| 428 | 233 (let* ((read-library-internal-search-path SEARCH-PATH) |
| 234 (library (completing-read PROMPT 'read-library-internal | |
| 235 FILTER (or MUST-MATCH FULL) nil))) | |
| 236 (cond | |
| 237 ((equal library "") DEFAULT) | |
| 238 (FULL (locate-file library read-library-internal-search-path | |
| 239 '(".el" ".el.gz" ".elc"))) | |
| 240 (t library)))) | |
| 241 | |
| 242 (defun read-library-name (prompt) | |
| 502 | 243 "PROMPTs for and returns an existing Elisp library name (without any suffix) |
| 244 or the empty string." | |
| 428 | 245 (interactive) |
| 502 | 246 (declare (special read-library-internal-search-path)) |
| 428 | 247 (let ((read-library-internal-search-path load-path)) |
| 248 (completing-read prompt | |
| 249 'read-library-internal | |
| 250 (lambda (fn) | |
| 251 (cond | |
| 252 ((string-match "\\.el\\(\\.gz\\|\\.Z\\)?$" fn) | |
| 253 (substring fn 0 (match-beginning 0))))) | |
| 254 t nil))) | |
| 255 | |
| 256 ;; NOTE: as a special case, read-library may be used to read a filename | |
| 257 ;; relative to the current directory, returning a *relative* pathname | |
| 258 ;; (read-file-name returns a full pathname). | |
| 259 ;; | |
| 260 ;; eg. (read-library "Local header: " '(nil) nil) | |
| 261 | |
| 262 ;;=== Replacement for load-library with completion ======================== | |
| 263 | |
| 264 (defun load-library (library) | |
| 265 "Load the library named LIBRARY. | |
| 266 This is an interface to the function `load'." | |
| 267 (interactive | |
| 268 (list (read-library "Load library: " load-path nil nil nil | |
| 269 (function (lambda (fn) | |
| 270 (cond | |
| 271 ((string-match "\\.elc?$" fn) | |
| 272 (substring fn 0 (match-beginning 0)))))) | |
| 273 ))) | |
| 274 (load library)) | |
| 275 | |
| 276 ;;=== find-library with completion (Author: Bob Weiner) =================== | |
| 277 | |
| 1123 | 278 ;; should be called find-lisp-source-path! |
| 531 | 279 (defcustom find-library-source-path nil |
| 280 "The default list of directories where find-library searches. | |
| 281 | |
| 282 If this variable is `nil' then find-library searches `load-path' by | |
| 283 default. | |
| 284 | |
| 1123 | 285 If this is set to a function, it will be called the first time this value |
| 286 is needed, to compute the actual list, which will then be substituted into | |
| 287 the variable. | |
| 288 | |
| 531 | 289 A good way to set this variable is like this: |
| 290 | |
| 291 \(setq find-library-source-path | |
| 1123 | 292 #'(lambda () |
| 293 (paths-find-recursive-load-path | |
| 294 (list lisp-directory \"/src/xemacs/xemacs-packages-src/\")))) | |
| 531 | 295 " |
| 296 :type '(repeat directory) | |
| 297 :group 'find-function) | |
| 298 | |
| 428 | 299 (defun find-library (library &optional codesys display-function) |
| 300 "Find and display in the current window the source for the Elisp LIBRARY. | |
| 301 LIBRARY should be a name without any path information and may include or omit | |
| 302 the \".el\" suffix. Under XEmacs/Mule, the optional second argument CODESYS | |
| 303 specifies the coding system to use when decoding the file. Interactively, | |
| 304 with a prefix argument, this prompts for the coding system. Optional third | |
| 305 argument DISPLAY-FUNCTION must take two arguments, the filename to display | |
| 531 | 306 and CODESYS. The default for DISPLAY-FUNCTION is `find-file'. |
| 307 | |
| 308 This function searches `find-library-source-path' to find the library; | |
| 309 if this is nil (the default), then `load-path' is searched." | |
| 428 | 310 (interactive |
| 311 (list (read-library-name "Find library: ") | |
| 312 (if current-prefix-arg | |
| 313 (read-coding-system "Coding System: ")))) | |
| 314 (let ((path (if (or (null library) (equal library "")) | |
| 315 nil | |
| 1123 | 316 (when (functionp find-library-source-path) |
| 317 (message "Computing find-library-source-path...") | |
| 318 (setq find-library-source-path | |
| 319 (funcall find-library-source-path)) | |
| 320 (message "Computing find-library-source-path... done.")) | |
| 531 | 321 (locate-file library (or find-library-source-path load-path) |
| 953 | 322 ":.el:.el.gz:.el.Z:.elc")))) |
| 428 | 323 (if path (funcall (if (fboundp display-function) |
| 324 display-function 'find-file) | |
| 325 path codesys) | |
| 326 (error "(find-library): Cannot locate library `%s'" library)))) | |
| 327 | |
| 328 (defun find-library-other-window (library &optional codesys) | |
| 329 "Find and display in another window the source for the Elisp LIBRARY. | |
| 330 LIBRARY should be a name without any path information and may include or omit | |
| 331 the \".el\" suffix. Under XEmacs/Mule, the optional second argument CODESYS | |
| 332 specifies the coding system to use when decoding the file. Interactively, | |
| 333 with a prefix argument, this prompts for the coding system." | |
| 334 (interactive | |
| 335 (list (read-library-name "Find library in other window: ") | |
| 336 (if current-prefix-arg | |
| 337 (read-coding-system "Coding System: ")))) | |
| 338 (find-library library codesys 'find-file-other-window)) | |
| 339 | |
| 340 (defun find-library-other-frame (library &optional codesys) | |
| 341 "Find and display in another frame the source for the Elisp LIBRARY. | |
| 342 LIBRARY should be a name without any path information and may include or omit | |
| 343 the \".el\" suffix. Under XEmacs/Mule, the optional second argument CODESYS | |
| 344 specifies the coding system to use when decoding the file. Interactively, | |
| 345 with a prefix argument, this prompts for the coding system." | |
| 346 (interactive | |
| 347 (list (read-library-name "Find library in other frame: ") | |
| 348 (if current-prefix-arg | |
| 349 (read-coding-system "Coding System: ")))) | |
| 350 (find-library library codesys 'find-file-other-frame)) | |
| 351 | |
| 352 ;; This conflicts with an existing binding. | |
| 353 ;;(define-key global-map "\C-xl" 'find-library) | |
| 354 (define-key global-map "\C-x4l" 'find-library-other-window) | |
| 355 (define-key global-map "\C-x5l" 'find-library-other-frame) | |
| 356 | |
| 357 (provide 'lib-complete) | |
| 358 | |
| 359 ;;; lib-complete.el ends here |