Mercurial > hg > xemacs-beta
annotate lisp/lib-complete.el @ 5655:b7ae5f44b950
Remove some redundant functions, change others to labels, lisp/
lisp/ChangeLog addition:
2012-05-05 Aidan Kehoe <kehoea@parhasard.net>
Remove some redundant functions; turn other utility functions into
labels, avoiding visibility in the global namespace, and reducing
the size of the dumped binary.
* auto-save.el (auto-save-unhex): Removed.
* auto-save.el (auto-save-unescape-name): Use #'string-to-number
instead of #'auto-save-unhex.
* files.el (save-some-buffers):
* files.el (save-some-buffers-1): Changed to a label.
* files.el (not-modified):
* gui.el (make-gui-button):
* gui.el (gui-button-action): Changed to a label.
* gui.el (insert-gui-button):
* indent.el (indent-for-tab-command):
* indent.el (insert-tab): Changed to a label.
* indent.el (indent-rigidly):
* isearch-mode.el:
* isearch-mode.el (isearch-ring-adjust):
* isearch-mode.el (isearch-ring-adjust1): Changed to a label.
* isearch-mode.el (isearch-pre-command-hook):
* isearch-mode.el (isearch-maybe-frob-keyboard-macros): Changed to
a label.
* isearch-mode.el (isearch-highlight):
* isearch-mode.el (isearch-make-extent): Changed to a label.
* itimer.el:
* itimer.el (itimer-decrement): Removed, replaced uses with decf.
* itimer.el (itimer-increment): Removed, replaced uses with incf.
* itimer.el (itimer-signum): Removed, replaced uses with minusp, plusp.
* itimer.el (itimer-name):
* itimer.el (check-itimer): Removed, replaced with #'check-type calls.
* itimer.el (itimer-value):
* itimer.el (check-itimer-coerce-string): Removed.
* itimer.el (itimer-restart):
* itimer.el (itimer-function):
* itimer.el (check-nonnegative-number): Removed.
* itimer.el (itimer-uses-arguments):
* itimer.el (check-string): Removed.
* itimer.el (itimer-function-arguments):
* itimer.el (itimer-recorded-run-time):
* itimer.el (set-itimer-name):
* itimer.el (set-itimer-value):
* itimer.el (set-itimer-value-internal):
* itimer.el (set-itimer-restart):
* itimer.el (set-itimer-function):
* itimer.el (set-itimer-is-idle):
* itimer.el (set-itimer-recorded-run-time):
* itimer.el (get-itimer):
* itimer.el (delete-itimer):
* itimer.el (start-itimer):
* itimer.el (activate-itimer):
* itimer.el (itimer-edit-set-field):
* itimer.el (itimer-edit-next-field):
* itimer.el (itimer-edit-previous-field):
Use incf, decf, plusp, minusp and the more general argument type
checking macros.
* lib-complete.el:
* lib-complete.el (lib-complete:better-root): Changed to a label.
* lib-complete.el (lib-complete:get-completion-table): Changed to
a label.
* lib-complete.el (read-library-internal): Include labels.
* lib-complete.el (lib-complete:cache-completions): Changed to a
label.
* minibuf.el (read-buffer): Use #'set-difference, don't reinvent it.
* newcomment.el (comment-padright): Use a label instead of
repeating a lambda expression.
* packages.el (package-get-key):
* packages.el (package-get-key-1): Removed, use #'getf instead.
* simple.el (kill-backward-chars): Removed; this isn't used.
* simple.el (what-cursor-position):
(lambda (arg) (format "%S" arg) -> #'prin1-to-string.
* simple.el (debug-print-1): Renamed to #'debug-print.
* simple.el (debug-print): Removed, #'debug-print-1 was equivalent.
* subr.el (integer-to-bit-vector): check-nonnegative-number no
longer available.
* widget.el (define-widget):
* widget.el (define-widget-keywords): Removed, this was long obsolete.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 05 May 2012 18:42:00 +0100 |
| parents | cc6f0266bc36 |
| 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 |