1 ;;; icicles-fn.el --- Non-interactive functions for Icicles
3 ;; Filename: icicles-fn.el
4 ;; Description: Non-interactive functions for Icicles
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 1996-2011, Drew Adams, all rights reserved.
8 ;; Created: Mon Feb 27 09:25:53 2006
10 ;; Last-Updated: Mon Sep 5 12:44:24 2011 (-0700)
13 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/icicles-fn.el
14 ;; Keywords: internal, extensions, help, abbrev, local, minibuffer,
15 ;; keys, apropos, completion, matching, regexp, command
16 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x
18 ;; Features that might be required by this library:
20 ;; `apropos', `apropos-fn+var', `backquote', `bytecomp', `cl',
21 ;; `el-swank-fuzzy', `ffap', `ffap-', `fuzzy', `fuzzy-match',
22 ;; `hexrgb', `icicles-face', `icicles-mac', `icicles-opt',
23 ;; `icicles-var', `kmacro', `levenshtein', `regexp-opt',
24 ;; `thingatpt', `thingatpt+', `wid-edit', `wid-edit+', `widget'.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;; This is a helper library for library `icicles.el'. It defines
31 ;; non-interactive functions. For Icicles documentation, see
32 ;; `icicles-doc1.el' and `icicles-doc2.el'.
34 ;; Macros defined here:
36 ;; `icicle-maybe-cached-action'.
38 ;; Non-interactive functions defined here:
40 ;; `assq-delete-all', `icicle-2nd-part-string-less-p',
41 ;; `icicle-abbreviate-or-expand-file-name',
42 ;; `icicle-all-completions', `icicle-alpha-p',
43 ;; `icicle-alt-act-fn-for-type', `icicle-any-candidates-p',
44 ;; `icicle-apropos-any-candidates-p',
45 ;; `icicle-apropos-any-file-name-candidates-p',
46 ;; `icicle-apropos-candidates',
47 ;; `icicle-barf-if-outside-Completions',
48 ;; `icicle-barf-if-outside-Completions-and-minibuffer',
49 ;; `icicle-barf-if-outside-minibuffer',
50 ;; `icicle-buffer-file/process-name-less-p',
51 ;; `icicle-buffer-smaller-p',
52 ;; `icicle-call-then-update-Completions', `icicle-candidate-set-1',
53 ;; `icicle-candidate-short-help',
54 ;; `icicle-case-insensitive-string-less-p',
55 ;; `icicle-case-string-less-p', `icicle-cdr-lessp',
56 ;; `icicle-choose-completion-string', `icicle-clear-lighter',
57 ;; `icicle-clear-minibuffer', `icicle-color-name-w-bg',
58 ;; `icicle-color-rgb-lessp', `icicle-command-abbrev-save',
59 ;; `icicle-command-abbrev-used-more-p',
60 ;; `icicle-command-names-alphabetic-p',
61 ;; `icicle-complete-again-update', `icicle-completing-p',
62 ;; `icicle-completing-read', `icicle-completing-read-multiple',
63 ;; `icicle-completing-read-history',
64 ;; `icicle-completion-all-completions',
65 ;; `icicle-completion-setup-function',
66 ;; `icicle-completion-try-completion', `icicle-current-TAB-method',
67 ;; `icicle-custom-type', `icicle-define-crm-completion-map',
68 ;; `icicle-delete-count', `icicle-delete-dups',
69 ;; `icicle-delete-whitespace-from-string',
70 ;; `icicle-dired-read-shell-command',
71 ;; `icicle-dired-smart-shell-command',
72 ;; `icicle-dir-prefix-wo-wildcards', `icicle-dirs-first-p',
73 ;; `icicle-dirs-last-p', `icicle-displayable-cand-from-saved-set',
74 ;; `icicle-display-cand-from-full-cand',
75 ;; `icicle-display-completion-list', `icicle-display-Completions',
76 ;; `icicle-display-candidates-in-Completions',
77 ;; `icicle-expanded-common-match',
78 ;; `icicle-expanded-common-match-1', `icicle-expand-file-name-20',
79 ;; `icicle-expand-file-or-dir-name',
80 ;; `icicle-explicit-saved-completion-candidates',
81 ;; `icicle-extra-candidates-first-p',
82 ;; `icicle-face-valid-attribute-values', `icicle-file-directory-p',
83 ;; `icicle-file-name-apropos-candidates',
84 ;; `icicle-file-name-directory',
85 ;; `icicle-file-name-directory-w-default',
86 ;; `icicle-file-name-input-p', `icicle-file-name-nondirectory',
87 ;; `icicle-file-name-prefix-candidates', `icicle-file-readable-p',
88 ;; `icicle-file-remote-p', `icicle-file-type-less-p',
89 ;; `icicle-file-writable-p', `icicle-filesets-files-under',
90 ;; `icicle-files-within', `icicle-files-within-1',
91 ;; `icicle-filter-alist', `icicle-filter-wo-input',
92 ;; `icicle-first-matching-candidate', `icicle-first-N',
93 ;; `icicle-fit-completions-window', `icicle-fix-default-directory',
94 ;; `icicle-frames-on', `icicle-fuzzy-candidates',
95 ;; `icicle-get-alist-candidate',
96 ;; `icicle-get-candidates-from-saved-set',
97 ;; `icicle-dired-guess-shell-command', `icicle-help-line-buffer',
98 ;; `icicle-help-line-file',
99 ;; `icicle-highlight-candidate-in-Completions',
100 ;; `icicle-highlight-complete-input',
101 ;; `icicle-highlight-initial-whitespace',
102 ;; `icicle-highlight-input-noncompletion',
103 ;; `icicle-highlight-input-noncompletion-rest',
104 ;; `icicle-highlight-lighter', `icicle-historical-alphabetic-p',
105 ;; `icicle-increment-cand-nb+signal-end',
106 ;; `icicle-input-from-minibuffer', `icicle-insert-candidates',
107 ;; `icicle-insert-cand-in-minibuffer',
108 ;; `icicle-insert-Completions-help-string',
109 ;; `icicle-isearch-complete-past-string', `icicle-join-nth-parts',
110 ;; `icicle-key-description', `icicle-kill-a-buffer',
111 ;; `icicle-last-modified-first-p', `icicle-levenshtein-match',
112 ;; `icicle-levenshtein-one-match', `icicle-levenshtein-one-regexp',
113 ;; `icicle-levenshtein-strict-match',
114 ;; `icicle-lisp-vanilla-completing-read',
115 ;; `icicle-local-keys-first-p', `icicle-make-plain-predicate',
116 ;; `icicle-major-mode-name-less-p', `icicle-make-face-candidate',
117 ;; `icicle-maybe-sort-and-strip-candidates',
118 ;; `icicle-maybe-sort-maybe-truncate', `icicle-mctize-all',
119 ;; `icicle-mctized-display-candidate',
120 ;; `icicle-mctized-full-candidate',
121 ;; `icicle-merge-saved-order-less-p',
122 ;; `icicle-minibuffer-default-add-completions',
123 ;; `icicle-minibuf-input', `icicle-minibuf-input-sans-dir',
124 ;; `icicle-minibuffer-default-add-dired-shell-commands',
125 ;; `icicle-minibuffer-prompt-end', `icicle-mode-line-name-less-p',
126 ;; `icicle-most-recent-first-p', `icicle-msg-maybe-in-minibuffer',
127 ;; `icicle-ms-windows-NET-USE', `icicle-multi-sort',
128 ;; `icicle-next-candidate', `icicle-not-basic-prefix-completion-p',
129 ;; `icicle-part-1-cdr-lessp', `icicle-part-1-lessp',
130 ;; `icicle-part-2-lessp', `icicle-part-3-lessp',
131 ;; `icicle-part-4-lessp', `icicle-part-N-lessp',
132 ;; `icicle-place-cursor', `icicle-place-overlay',
133 ;; `icicle-position', `icicle-prefix-any-candidates-p',
134 ;; `icicle-prefix-any-file-name-candidates-p',
135 ;; `icicle-prefix-candidates', `icicle-prefix-keys-first-p',
136 ;; `icicle-proxy-candidate-first-p', `icicle-put-at-head',
137 ;; `icicle-put-whole-cand-prop',
138 ;; `icicle-quote-file-name-part-of-cmd',
139 ;; `icicle-readable-to-markers', `icicle-read-char-exclusive',
140 ;; `icicle-read-face-name', `icicle-read-file-name',
141 ;; `icicle-read-from-minibuffer',
142 ;; `icicle-read-from-minibuf-nil-default', `icicle-read-number',
143 ;; `icicle-read-shell-command',
144 ;; `icicle-read-shell-command-completing', `icicle-read-string',
145 ;; `icicle-read-string-completing',
146 ;; `icicle-recentf-make-menu-items', `icicle-recompute-candidates',
147 ;; `icicle-redefine-standard-options',
148 ;; `icicle-redefine-std-completion-fns',
149 ;; `icicle-remove-color-duplicates', `icicle-remove-dots',
150 ;; `icicle-remove-duplicates', `icicle-remove-dups-if-extras',
151 ;; `icicle-remove-if', `icicle-remove-if-not',
152 ;; `icicle-remove-property', `icicle-replace-mct-cand-in-mct',
153 ;; `icicle-require-match-p', `icicle-restore-standard-commands',
154 ;; `icicle-restore-standard-options',
155 ;; `icicle-restore-std-completion-fns', `icicle-reversible-sort',
156 ;; `icicle-saved-fileset-p', `icicle-save-or-restore-input',
157 ;; `icicle-save-raw-input', `icicle-scatter',
158 ;; `icicle-scatter-match', `icicle-scroll-or-update-Completions',
159 ;; `icicle-set-difference', `icicle-set-intersection',
160 ;; `icicle-set-union', `icicle-shell-command',
161 ;; `icicle-shell-command-on-region',
162 ;; `icicle-show-help-in-mode-line', `icicle-show-in-mode-line',
163 ;; `icicle-special-candidates-first-p',
164 ;; `icicle-start-of-candidates-in-Completions',
165 ;; `icicle-strip-ignored-files-and-sort',
166 ;; `icicle-subst-envvar-in-file-name',
167 ;; `icicle-substring-no-properties', `icicle-substrings-of-length',
168 ;; `icicle-take', `icicle-toggle-icicle-mode-twice',
169 ;; `icicle-transform-candidates',
170 ;; `icicle-transform-multi-completion',
171 ;; `icicle-unhighlight-lighter', `icicle-unpropertize',
172 ;; `icicle-unsorted-apropos-candidates',
173 ;; `icicle-unsorted-file-name-apropos-candidates',
174 ;; `icicle-unsorted-file-name-prefix-candidates',
175 ;; `icicle-unsorted-prefix-candidates', `icicle-upcase',
176 ;; `icicle-value-satisfies-type-p', `icicle-var-inherits-type-p',
177 ;; `icicle-var-is-of-type-p', `icicle-var-matches-type-p',
178 ;; `icicle-var-val-satisfies-type-p',
179 ;; `old-choose-completion-string', `old-completing-read',
180 ;; `old-completing-read-multiple', `old-completion-setup-function',
181 ;; `old-dired-smart-shell-command', `old-display-completion-list',
182 ;; `old-face-valid-attribute-values',
183 ;; `old-minibuffer-default-add-completions', `old-read-face-name',
184 ;; `old-read-from-minibuffer', `old-read-number',
185 ;; `old-read-string', `old-shell-command',
186 ;; `old-shell-command-on-region'.
188 ;; Internal variables defined here:
190 ;; `icicle-crm-local-completion-map',
191 ;; `icicle-crm-local-must-match-map', `icicle-dirs-done',
192 ;; `icicle-files', `old-crm-local-completion-map',
193 ;; `old-crm-local-must-match-map'.
196 ;; ***** NOTE: These EMACS PRIMITIVES have been REDEFINED HERE:
198 ;; `completing-read' - (See below and doc string.)
199 ;; `display-completion-list' - (See below and doc string.)
200 ;; `face-valid-attribute-values' - (See below and doc string.)
201 ;; `read-file-name' Emacs 20, 21 only - (See below and doc string.)
202 ;; `read-from-minibuffer' - (See below and doc string.)
203 ;; `read-string' - (See below and doc string.)
206 ;; ***** NOTE: The following functions defined in `simple.el' have
207 ;; been REDEFINED HERE:
209 ;; `choose-completion-string' -
210 ;; Don't exit minibuffer after `lisp-complete-symbol' completion.
211 ;; `completion-setup-function' - 1. Put faces on inserted string(s).
213 ;; `repeat-complex-command' - Use `completing-read' to read command.
216 ;; ***** NOTE: The following function defined in `filesets.el' has
217 ;; been REDEFINED HERE:
219 ;; `filesets-get-filelist' - Fix. Bug #976 reported to Emacs devel.
221 ;; For descriptions of changes to this file, see `icicles-chg.el'.
225 ;; If you have library `linkd.el' and Emacs 22 or later, load
226 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
227 ;; navigate around the sections of this doc. Linkd mode will
228 ;; highlight this Index, as well as the cross-references and section
229 ;; headings throughout this file. You can get `linkd.el' here:
230 ;; http://dto.freeshell.org/notebook/Linkd.html.
232 ;; (@> "Redefined standard functions")
233 ;; (@> "Icicles functions - completion display (not cycling)")
234 ;; (@> "Icicles functions - TAB completion cycling")
235 ;; (@> "Icicles functions - S-TAB completion cycling")
236 ;; (@> "Icicles functions - common helper functions")
237 ;; (@> "Icicles functions - sort functions")
239 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
241 ;; This program is free software; you can redistribute it and/or
242 ;; modify it under the terms of the GNU General Public License as
243 ;; published by the Free Software Foundation; either version 2, or (at
244 ;; your option) any later version.
246 ;; This program is distributed in the hope that it will be useful, but
247 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
248 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
249 ;; General Public License for more details.
251 ;; You should have received a copy of the GNU General Public License
252 ;; along with this program; see the file COPYING. If not, write to
253 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
254 ;; Floor, Boston, MA 02110-1301, USA.
256 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
260 (eval-when-compile (require 'cl)) ;; case, lexical-let, loop
261 ;; plus, for Emacs < 21: dolist, push, pop
263 (require 'hexrgb nil t) ;; (no error if not found): hexrgb-color-name-to-hex
264 (require 'wid-edit+ nil t) ;; (no error if not found):
265 ;; redefined color widget (for icicle-var-is-of-type-p)
268 (or (condition-case nil
269 (load-library "icicles-mac") ; Use load-library to ensure latest .elc.
271 (require 'icicles-mac))) ; Require, so can load separately if not on `load-path'.
272 ;; icicle-with-selected-window
273 (require 'icicles-opt) ; (This is required anyway by `icicles-var.el'.)
274 ;; icicle-Completions-display-min-input-chars, icicle-cycle-into-subdirs-flag,
275 ;; icicle-expand-input-to-common-match-flag, icicle-hide-common-match-in-Completions-flag,
276 ;; icicle-hide-non-matching-lines-flag, icicle-highlight-historical-candidates-flag,
277 ;; icicle-highlight-input-initial-whitespace-flag, icicle-ignore-space-prefix-flag,
278 ;; icicle-incremental-completion-delay, icicle-incremental-completion-flag,
279 ;; icicle-incremental-completion-threshold, icicle-default-value, icicle-list-join-string,
280 ;; icicle-mark-position-in-candidate, icicle-point-position-in-candidate, icicle-regexp-quote-flag,
281 ;; icicle-require-match-flag,
282 ;; icicle-show-Completions-help-flag, icicle-sort-comparer, icicle-special-candidate-regexp,
283 ;; icicle-transform-function, icicle-use-~-for-home-dir-flag
284 (require 'icicles-var)
285 ;; icicle-candidate-nb, icicle-candidate-action-fn, icicle-candidate-properties-alist,
286 ;; icicle-cmd-calling-for-completion, icicle-common-match-string, icicle-complete-input-overlay,
287 ;; icicle-completing-p, icicle-completion-candidates, icicle-current-completion-mode,
288 ;; icicle-current-input, icicle-current-raw-input, icicle-default-directory, icicle-edit-update-p,
289 ;; icicle-extra-candidates, icicle-ignored-extensions-regexp, icicle-incremental-completion-p,
290 ;; icicle-initial-value, icicle-last-completion-candidate, icicle-last-input,
291 ;; icicle-must-match-regexp, icicle-must-not-match-regexp, icicle-must-pass-predicate,
292 ;; icicle-must-pass-after-match-predicate, icicle-nb-of-other-cycle-candidates, icicle-re-no-dot,
293 ;; icicle-reverse-sort-p, icicle-saved-completion-candidates
295 ;; This requirement is real, but leads to recursion.
296 ;; You should, in any case, just load everything by loading `icicles.el'.
297 ;; (require 'icicles-mode) ;; icicle-mode
300 ;; Byte-compiling this file, you will likely get some error or warning
301 ;; messages due to differences between different versions of Emacs.
304 ;;; Defvars to quiet the byte-compiler:
306 (when (< emacs-major-version 22)
307 (defvar completion-common-substring)
308 (defvar completion-root-regexp)
309 (defvar minibuffer-completing-symbol)
310 (defvar minibuffer-prompt-properties)
311 (defvar partial-completion-mode)
312 (defvar read-file-name-completion-ignore-case)
313 (defvar minibuffer-local-filename-completion-map)
314 (defvar minibuffer-local-must-match-filename-map)
315 (defvar minibuffer-local-filename-must-match-map)
316 (defvar read-file-name-predicate)
317 (defvar tooltip-mode))
319 (when (< emacs-major-version 23)
320 (defvar completion-styles) ; In `minibuffer.el'
321 (defvar icicle-Completions-text-scale-decrease)) ; In `icicles-opt.el' (for Emacs 23)
323 (defvar completion-root-regexp) ; In `simple.el' (for Emacs 22 and 23.1)
324 (defvar doremi-boost-down-keys) ; In `doremi.el'
325 (defvar doremi-boost-up-keys) ; In `doremi.el'
326 (defvar doremi-down-keys) ; In `doremi.el'
327 (defvar doremi-up-keys) ; In `doremi.el'
328 (defvar eyedrop-picked-background) ; In `eyedrop.el' and `palette.el'
329 (defvar eyedrop-picked-foreground) ; In `eyedrop.el' and `palette.el'
330 (defvar filesets-data) ; In `filesets.el'
331 (defvar font-width-table) ; In C code.
332 (defvar font-weight-table) ; In C code.
333 (defvar font-slant-table) ; In C code.
334 (defvar list-colors-sort) ; In `facemenu.el'
335 (defvar 1on1-*Completions*-frame-flag) ; In `oneonone.el'
336 (defvar shell-completion-execonly) ; In `shell.el'
337 (defvar recentf-list) ; In `recentf.el'
338 (defvar recentf-menu-filter-commands)
339 (defvar recentf-menu-filter)
340 (defvar recentf-max-menu-items)
341 (defvar recentf-menu-open-all-flag)
342 (defvar recentf-menu-filter-commands)
343 (defvar recentf-menu-items-for-commands)
345 ;; The name changed during development of Emacs 23. They aliased it for 23.1, but removed it for 23.2.
346 ;; Use the new name and alias the old, but don't declare old obsolete (let Emacs 23 do that.)
347 (when (and (boundp 'minibuffer-local-must-match-filename-map) (fboundp 'defvaralias)) ; Emacs 22
348 (defvar minibuffer-local-filename-must-match-map minibuffer-local-must-match-filename-map
349 "Local keymap for minibuffer input with completion for filenames with exact match.")
350 (defvaralias 'minibuffer-local-must-match-filename-map 'minibuffer-local-filename-must-match-map))
352 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
354 ;;(@* "Redefined standard functions")
356 ;;; Redefined standard functions -------------------------------------
359 ;; REPLACE ORIGINAL `choose-completion-string' in `simple.el',
360 ;; saving it for restoration when you toggle `icicle-mode'.
362 ;; Don't exit minibuffer if this is just a `lisp-complete-symbol' completion.
363 ;; Go to point-max before insert choice. Respect `icicle-dir-candidate-can-exit-p'.
365 ;; Free variable `completion-reference-buffer' is defined in `simple.el'.
367 (unless (fboundp 'old-choose-completion-string)
368 (defalias 'old-choose-completion-string (symbol-function 'choose-completion-string)))
370 (cond ((> emacs-major-version 21) ; Emacs 22+
371 (defun icicle-choose-completion-string (choice &optional buffer base-size)
372 "Switch to BUFFER and insert the completion choice CHOICE.
373 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
374 to keep. If it is nil, we call `choose-completion-delete-max-match'
375 to decide what to delete.
376 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
377 the following is true:
378 - it is reading a file name, CHOICE is a directory, and
379 `icicle-dir-candidate-can-exit-p' is nil
380 - `completion-no-auto-exit' is non-nil
381 - this is just a `lisp-complete-symbol' completion."
382 (let* ((buffer (or buffer completion-reference-buffer))
383 (mini-p (minibufferp buffer)))
384 ;; If BUFFER is a minibuffer, barf unless it's currently active.
385 (if (and mini-p (or (not (active-minibuffer-window))
386 (not (equal buffer (window-buffer (active-minibuffer-window))))))
387 (error "Minibuffer is not active for completion")
388 ;; Set buffer so buffer-local `choose-completion-string-functions' works.
390 (unless (run-hook-with-args-until-success 'choose-completion-string-functions
391 choice buffer mini-p base-size)
392 ;;; $$$$$$ Removed this because it led to an error in Emacs 24, since base-size is nil there.
393 ;;; Anyway, Icicles doesn't really need or use base-size or `choose-completion-delete-max-match'.
394 ;;; ;; Insert the completion into the buffer where completion was requested.
396 ;;; (delete-region (+ base-size (if mini-p (minibuffer-prompt-end) (point-min)))
397 ;;; (if mini-p (point-max) (point)))
398 ;;; (choose-completion-delete-max-match choice))
400 ;; Forget about base-size altogether. Replace the whole input always.
401 (delete-region (+ (or base-size 0) (if mini-p (minibuffer-prompt-end) (point-min)))
402 (if mini-p (point-max) (point)))
403 (when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
405 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
406 ;; Update point in the window that BUFFER is showing in.
407 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
408 ;; If completing for the minibuffer, exit it with this choice,
409 ;; unless this was a `lisp-complete-symbol' completion.
410 (and (not completion-no-auto-exit)
411 (equal buffer (window-buffer (minibuffer-window)))
412 (or minibuffer-completion-table
413 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
414 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
415 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
416 ;; or not reading a file name, or chosen file is not a directory.
417 (if (or icicle-dir-candidate-can-exit-p
418 (not (eq minibuffer-completion-table 'read-file-name-internal))
419 (not (file-directory-p (field-string (point-max)))))
421 (let ((mini (active-minibuffer-window)))
423 (when minibuffer-auto-raise (raise-frame (window-frame mini)))))))))))
425 ((> emacs-major-version 20) ; Emacs 21
426 (defun icicle-choose-completion-string (choice &optional buffer base-size)
427 "Switch to BUFFER and insert the completion choice CHOICE.
428 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
429 to keep. If it is nil, we call `choose-completion-delete-max-match'
430 to decide what to delete.
431 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
432 the following is true:
433 - it is reading a file name, CHOICE is a directory, and
434 `icicle-dir-candidate-can-exit-p' is nil
435 - `completion-no-auto-exit' is non-nil
436 - this is just a `lisp-complete-symbol' completion."
437 (let ((buffer (or buffer completion-reference-buffer))
438 (mini-p (save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
439 (buffer-name buffer)))))
440 ;; If BUFFER is a minibuffer, barf unless it's currently active.
441 (if (and mini-p (or (not (active-minibuffer-window))
442 (not (equal buffer (window-buffer (active-minibuffer-window))))))
443 (error "Minibuffer is not active for completion")
444 ;; Insert the completion into the buffer where completion was requested.
447 (delete-region (+ base-size (if mini-p (icicle-minibuffer-prompt-end) (point-min)))
448 (if mini-p (point-max) (point)))
449 (choose-completion-delete-max-match choice))
450 (when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
452 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
453 ;; Update point in the window that BUFFER is showing in.
454 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
455 ;; If completing for the minibuffer, exit it with this choice,
456 ;; unless this was a `lisp-complete-symbol' completion.
457 (and (not completion-no-auto-exit)
458 (equal buffer (window-buffer (minibuffer-window)))
459 (or minibuffer-completion-table
460 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
461 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
462 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
463 ;; or not reading a file name, or chosen file is not a directory.
464 (if (or icicle-dir-candidate-can-exit-p
465 (not (eq minibuffer-completion-table 'read-file-name-internal))
466 (not (file-directory-p (field-string (point-max)))))
468 (let ((mini (active-minibuffer-window)))
470 (when minibuffer-auto-raise (raise-frame (window-frame mini))))))))))
473 (defun icicle-choose-completion-string (choice &optional buffer base-size)
474 "Switch to BUFFER and insert the completion choice CHOICE.
475 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
476 to keep. If it is nil, we call `choose-completion-delete-max-match'
477 to decide what to delete.
478 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
479 the following is true:
480 - it is reading a file name, CHOICE is a directory, and
481 `icicle-dir-candidate-can-exit-p' is nil
482 - `completion-no-auto-exit' is non-nil
483 - this is just a `lisp-complete-symbol' completion."
484 (let ((buffer (or buffer completion-reference-buffer))
485 (mini-p (save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
486 (buffer-name buffer)))))
487 ;; If BUFFER is a minibuffer, barf unless it's currently active.
488 (when (and mini-p (or (not (active-minibuffer-window))
489 (not (equal buffer (window-buffer (active-minibuffer-window))))))
490 (error "Minibuffer is not active for completion"))
491 ;; Insert the completion into the buffer where completion was requested.
494 (delete-region (+ base-size (point-min)) (if mini-p (point-max) (point)))
495 (choose-completion-delete-max-match choice))
496 (when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
498 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
499 ;; Update point in the window that BUFFER is showing in.
500 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
501 ;; If completing for the minibuffer, exit it with this choice,
502 ;; unless this was a `lisp-complete-symbol' completion.
503 (and (not completion-no-auto-exit)
504 (equal buffer (window-buffer (minibuffer-window)))
505 (or minibuffer-completion-table
506 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
507 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
508 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
509 ;; or not reading a file name, or chosen file is not a directory.
510 (if (or icicle-dir-candidate-can-exit-p
511 (not (eq minibuffer-completion-table 'read-file-name-internal))
512 (not (file-directory-p (buffer-string))))
514 (select-window (active-minibuffer-window))))))))
517 ;; REPLACE ORIGINAL `completion-setup-function' in `simple.el',
518 ;; saving it for restoration when you toggle `icicle-mode'.
520 ;; Don't print the help lines here. Do that in `icicle-display-completion-list' instead.
521 ;; That's so we can fit the `*Completions*' window to the buffer, including the help lines.
523 (unless (fboundp 'old-completion-setup-function)
524 (defalias 'old-completion-setup-function (symbol-function 'completion-setup-function)))
526 (when (< emacs-major-version 22)
527 (defun icicle-completion-setup-function ()
528 "Set up for completion. This goes in `completion-setup-hook'
529 so it is called after completion-list buffer text is written."
531 (let* ((mainbuf (current-buffer))
532 (mbuf-contents (icicle-input-from-minibuffer))
533 ;; $$$$$ Should we `expand-file-name' mbuf-contents first?
534 (dir-of-input (and minibuffer-completing-file-name
535 (icicle-file-name-directory mbuf-contents))))
536 ;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
537 ;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
538 (when (and dir-of-input
539 (or (and (symbolp this-command) (get this-command 'icicle-completing-command))
540 (not icicle-comp-base-is-default-dir-p)))
541 (with-current-buffer mainbuf (setq default-directory dir-of-input)))
542 (with-current-buffer standard-output
543 (completion-list-mode)
544 (set (make-local-variable 'completion-reference-buffer) mainbuf)
545 (setq completion-base-size
546 (cond ((and (eq minibuffer-completion-table 'read-file-name-internal)
547 icicle-comp-base-is-default-dir-p
548 (length default-directory)))
549 ((eq minibuffer-completion-table 'read-file-name-internal)
550 ;; For file name completion, use the number of chars before
551 ;; the start of the file name component at point.
552 (with-current-buffer mainbuf
553 (save-excursion (skip-chars-backward "^/")
554 (- (point) (icicle-minibuffer-prompt-end)))))
555 ((save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
556 (buffer-name mainbuf)))
557 ;; Otherwise, in minibuffer, the whole input is being completed.
560 (when (or (= emacs-major-version 22) ; Emacs 22 or 23.1
561 (and (= emacs-major-version 23) (= emacs-minor-version 1)))
562 (defun icicle-completion-setup-function ()
563 "Set up for completion. This goes in `completion-setup-hook'
564 so it is called after completion-list buffer text is written."
566 (let* ((mainbuf (current-buffer))
567 (mbuf-contents (minibuffer-completion-contents)) ; Get contents only up to point.
568 ;; $$$$$ Should we `expand-file-name' mbuf-contents first? Vanilla Emacs does that.
569 (dir-of-input (and minibuffer-completing-file-name
570 (icicle-file-name-directory mbuf-contents)))
571 common-string-length)
572 ;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
573 ;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
574 (when (and dir-of-input
575 (or (and (symbolp this-command) (get this-command 'icicle-completing-command))
576 (not icicle-comp-base-is-default-dir-p)))
577 (with-current-buffer mainbuf (setq default-directory dir-of-input)))
578 (with-current-buffer standard-output
579 (completion-list-mode)
580 (set (make-local-variable 'completion-reference-buffer) mainbuf)
581 (setq completion-base-size
582 (cond ((and minibuffer-completing-file-name icicle-comp-base-is-default-dir-p
583 (length default-directory)))
584 ((and (symbolp minibuffer-completion-table)
585 (get minibuffer-completion-table 'completion-base-size-function))
586 ;; To compute base size, a function can use the global value of
587 ;; `completion-common-substring' or `minibuffer-completion-contents'.
588 (with-current-buffer mainbuf
589 (funcall (get minibuffer-completion-table 'completion-base-size-function))))
590 (minibuffer-completing-file-name
591 ;; For file name completion, use the number of chars before
592 ;; the start of the file name component at point.
593 (with-current-buffer mainbuf
594 (save-excursion (skip-chars-backward completion-root-regexp)
595 (- (point) (minibuffer-prompt-end)))))
596 ((and (boundp 'minibuffer-completing-symbol) minibuffer-completing-symbol) nil)
597 ;; Otherwise, in minibuffer, the base size is 0.
598 ((minibufferp mainbuf) 0)))
599 (setq common-string-length
600 (cond (completion-common-substring (length completion-common-substring))
601 (completion-base-size (- (length mbuf-contents) completion-base-size))))
602 ;; Put faces on first uncommon characters and common parts.
603 (when (and (integerp common-string-length) (>= common-string-length 0))
604 (let ((element-start (point-min))
607 (while (and (setq element-start (next-single-property-change element-start 'mouse-face))
608 (< (setq element-common-end (+ element-start common-string-length))
610 (when (get-char-property element-start 'mouse-face)
611 (if (and (> common-string-length 0)
612 (get-char-property (1- element-common-end) 'mouse-face))
613 (put-text-property element-start element-common-end
614 'font-lock-face 'completions-common-part))
615 (if (get-char-property element-common-end 'mouse-face)
616 (put-text-property element-common-end (1+ element-common-end)
617 'font-lock-face 'completions-first-difference)))))))))))
619 (when (or (> emacs-major-version 23) ; Emacs 23.2+
620 (and (= emacs-major-version 23) (>= emacs-minor-version 2)))
621 (defun icicle-completion-setup-function ()
622 "Set up for completion. This goes in `completion-setup-hook'
623 so it is called after completion-list buffer text is written."
624 ;; I could probably get rid of even more of the vanilla vestiges here...
626 (let* ((mainbuf (current-buffer))
627 (mbuf-contents (minibuffer-completion-contents)) ; Get contents only up to point.
628 ;; $$$$$ Should we `expand-file-name' mbuf-contents first? Vanilla Emacs does that.
629 (dir-of-input (and minibuffer-completing-file-name
630 (icicle-file-name-directory mbuf-contents))))
631 ;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
632 ;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
633 (when (and dir-of-input
634 (or (and (symbolp this-command) (get this-command 'icicle-completing-command))
635 (not icicle-comp-base-is-default-dir-p)))
636 (with-current-buffer mainbuf (setq default-directory dir-of-input)))
637 (with-current-buffer standard-output
638 (completion-list-mode)
639 (set (make-local-variable 'completion-reference-buffer) mainbuf))))))
641 (defun icicle-insert-Completions-help-string ()
642 "Add or remove help in `*Completions*'.
643 This is controlled by `icicle-show-Completions-help-flag'. If that
644 option is nil, remove help; else, add it."
645 (if icicle-show-Completions-help-flag
646 (let ((instruction2 (or (and icicle-mode (substitute-command-keys
647 (concat "(\\<minibuffer-local-completion-map>"
648 "\\[icicle-minibuffer-help]: help) ")))
651 (cond ((< emacs-major-version 22)
652 (setq instruction1 (if window-system ; We have a mouse.
653 (substitute-command-keys "Click \\<completion-list-mode-map>\
654 \\[mouse-choose-completion] on a completion to select it. ")
655 (substitute-command-keys ; No mouse.
656 "In this buffer, type \\<completion-list-mode-map>\
657 \\[choose-completion] to select the completion near point. "))))
658 ((>= emacs-major-version 22)
659 (setq instruction1 (if (display-mouse-p) ; We have a mouse.
660 (substitute-command-keys
661 "Click \\<completion-list-mode-map>\
662 \\[mouse-choose-completion] or type \\[choose-completion] on a completion to select it. ")
663 (substitute-command-keys ; No mouse.
664 "In this buffer, type \\<completion-list-mode-map>\
665 \\[choose-completion] to select the completion near point. ")))))
666 (goto-char (point-min))
667 (put-text-property 0 (length instruction1) 'face 'icicle-Completions-instruction-1
669 (put-text-property 0 (length instruction2) 'face 'icicle-Completions-instruction-2
671 (insert instruction1 instruction2 "\n"))
673 ;; Not showing help. Remove standard Emacs help string.
674 (goto-char (point-min))
675 (re-search-forward "Possible completions are:\n")
676 (delete-region (point-min) (point))))
678 (defun icicle-read-from-minibuf-nil-default (prompt &optional initial-contents keymap read hist
679 default-value inherit-input-method)
680 "Like `read-from-minibuffer', but return nil for empty input.
681 Args are as for `read-from-minibuffer'.
682 If nothing is input, then nil is returned."
683 (let ((input (read-from-minibuffer prompt initial-contents keymap nil hist default-value
684 inherit-input-method)))
685 (if (string= "" input) nil (if read (car (read-from-string input)) input))))
687 (defun icicle-completing-read-history (prompt &optional hist pred init-input def inherit-i-m)
688 "Lax `completing-read' against entries in history HIST.
689 Arguments are as for `completing-read'. HIST is a symbol that is a
690 history variable. It defaults to `minibuffer-history'. Completion is
691 lax: a match is not required."
692 (setq hist (or hist 'minibuffer-history))
693 (let ((hist-val (icicle-remove-duplicates (symbol-value hist))))
694 (when (and (consp hist-val) (not (stringp (car hist-val)))) ; Convert, e.g. `comand-history'.
695 (setq hist-val (mapcar (lambda (v) (format "%s" v)) hist-val)))
696 (completing-read prompt (mapcar #'list hist-val) pred nil init-input hist def inherit-i-m)))
698 ;; Based on the Emacs 22 C code that defined `completing-read'.
699 (defun icicle-lisp-vanilla-completing-read (prompt collection &optional predicate require-match
700 initial-input hist def inherit-input-method)
701 "Lisp version of vanilla Emacs `completing-read'."
702 (let ((pos 0) val histvar histpos position init)
703 (setq init initial-input
704 minibuffer-completion-table collection
705 minibuffer-completion-predicate predicate
706 minibuffer-completion-confirm (if (eq require-match t) nil require-match))
709 (when (consp init) (setq position (cdr init)
711 (unless (stringp init)
712 (error "icicle-lisp-vanilla-completing-read, INIT must be a string: %S" init))
714 (setq pos (1+ (length init))) ; Default is to put cursor at end of INITIAL-INPUT.
715 (unless (integerp position)
716 (error "icicle-lisp-vanilla-completing-read, POSITION must be an integer: %S" position))
717 (setq pos (1+ position)))) ; Convert zero-based to one-based.
721 (setq histvar (car-safe hist)
722 histpos (cdr-safe hist)))
723 (unless histvar (setq histvar 'minibuffer-history))
724 (unless histpos (setq histpos 0))
726 ;; (setq val (read-from-minibuffer
728 ;; (cons init pos) ; initial-contents
729 ;; (if (not require-match) ; key map
730 ;; (if (or (not minibuffer-completing-file-name)
731 ;; (eq minibuffer-completing-file-name 'lambda)
732 ;; (not (boundp 'minibuffer-local-filename-completion-map)))
733 ;; minibuffer-local-completion-map
734 ;; minibuffer-local-filename-completion-map)
735 ;; (if (or (not minibuffer-completing-file-name)
736 ;; (eq minibuffer-completing-file-name 'lambda)
737 ;; (not (boundp 'minibuffer-local-filename-must-match-map)))
738 ;; minibuffer-local-must-match-map
739 ;; minibuffer-local-filename-must-match-map))
740 ;; nil histvar def inherit-input-method))
741 (setq val (read-from-minibuffer
743 (cons init pos) ; initial-contents
744 (if (not require-match) ; keymap
745 (if (or (not minibuffer-completing-file-name)
746 (eq minibuffer-completing-file-name 'lambda)
747 (not (boundp 'minibuffer-local-filename-completion-map)))
748 minibuffer-local-completion-map
749 (if (fboundp 'make-composed-keymap) ; Emacs 24, starting July 2011.
750 (make-composed-keymap
751 minibuffer-local-filename-completion-map
752 minibuffer-local-completion-map)
753 minibuffer-local-filename-completion-map))
754 (if (or (not minibuffer-completing-file-name)
755 (eq minibuffer-completing-file-name 'lambda)
756 (and (not (fboundp 'make-composed-keymap)) ; Emacs 24, starting July 2011.
757 (not (boundp 'minibuffer-local-filename-must-match-map))))
758 minibuffer-local-must-match-map
759 (if (fboundp 'make-composed-keymap) ; Emacs 24, starting July 2011.
760 (make-composed-keymap
761 minibuffer-local-filename-completion-map
762 minibuffer-local-must-match-map)
763 minibuffer-local-filename-must-match-map)))
764 nil histvar def inherit-input-method))
765 ;; Use `icicle-filtered-default-value', not DEF, because `read-from-minibuffer' filters it.
766 (when (consp icicle-filtered-default-value) ; Emacs 23 lets DEF be a list of strings - use first.
767 (setq icicle-filtered-default-value (car icicle-filtered-default-value)))
768 (when (and (stringp val) (string= val "") icicle-filtered-default-value)
769 (setq val icicle-filtered-default-value))
773 ;; REPLACE ORIGINAL `completing-read' (built-in function),
774 ;; saving it for restoration when you toggle `icicle-mode'.
776 ;; Allows for completion candidates that are lists of strings.
777 ;; Allows for reading and returning completion candidates that are strings with properties.
778 ;; Adds completion status indicator to minibuffer and mode-line lighter.
779 ;; Removes `*Completions*' window.
781 ;; We use HIST-m@%=!$+&^*z instead of HIST, to avoid name capture by `minibuffer-history-variable's
782 ;; value. If we didn't need to be Emacs 20-compatible, then we could employ
783 ;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
785 (unless (fboundp 'old-completing-read)
786 (defalias 'old-completing-read (symbol-function 'completing-read)))
788 (defun icicle-completing-read (prompt collection &optional predicate require-match
789 initial-input hist-m@%=!$+&^*z def inherit-input-method)
790 "Read string in minibuffer, with completion and cycling of completions.
791 Prefix completion via \\<minibuffer-local-completion-map>\
792 `\\[icicle-prefix-word-complete]' (word) and `\\[icicle-prefix-complete]' (full).
793 Apropos (regexp) completion via `\\[icicle-apropos-complete]'.
795 Prefix cycling of candidate completions via `\\[icicle-previous-prefix-candidate]' and \
796 `\\[icicle-next-prefix-candidate]'.
797 Apropos cycling of candidate completions via `\\[icicle-previous-apropos-candidate]' and \
798 `\\[icicle-next-apropos-candidate]'.
800 Cycling of past minibuffer inputs via `\\[previous-history-element]' and \
801 `\\[next-history-element]'.
802 Searching through input history via `\\[previous-matching-history-element]' \
803 and `\\[next-matching-history-element]'.
805 Case is ignored if `completion-ignore-case' is non-nil.
806 Position of the cursor (point) and the mark during completion cycling
807 is determined by `icicle-point-position-in-candidate' and
808 `icicle-mark-position-in-candidate', respectively.
809 Highlighting of the matched part of completion candidates during
810 cycling is determined by `icicle-match-highlight-minibuffer',
811 `icicle-match-highlight-Completions', and
812 `icicle-common-match-highlight-Completions'.
814 Use `\\[icicle-minibuffer-help]' during completion for more information on completion and key
815 bindings in Icicle mode.
817 PROMPT is a string to prompt with. It normally ends in a colon and a
818 space. If PROMPT has non-nil text property `icicle-fancy-candidates'
819 on its first character, then completion candidates can be fancy - they
820 can have properties. However, if all of the candidates would be
821 acceptable to vanilla Emacs, then PROMPT need not use property
822 `icicle-fancy-candidates', even for candidates that have text
823 properties. Property `icicle-fancy-candidates' is needed only for
824 candidates that require encoding and decoding to store and retrieve
825 properties. See the Icicles doc, section `Programming with Fancy
828 COLLECTION is an obarray or an alist whose elements' cars are strings.
829 It can also be a function that performs the completion itself.
830 In Emacs 22 or later, it can also be a hash table or list of strings.
832 In Icicle mode, the car of an alist entry can also be a list of
833 strings. In this case, the completion candidate is a
834 multi-completion. The strings are joined pairwise with
835 `icicle-list-join-string' to form the completion candidate seen by the
836 user. You can use variable `icicle-candidate-properties-alist' to
837 control the appearance of multi-completions in buffer `*Completions*'.
838 You can use variables `icicle-list-use-nth-parts' and
839 `icicle-list-nth-parts-join-string' to control the minibuffer behavior
840 of multi-completions. See the Icicles documentation for more
843 PREDICATE limits completion to a subset of COLLECTION.
845 See `try-completion' and `all-completions' for more details on
846 completion, COLLECTION, and PREDICATE.
848 REQUIRE-MATCH can take any of these values:
849 * nil means the user can exit using any input.
850 * t means the user can exit only if the input is (or completes to) an
851 element of COLLECTION or is null.
852 * In Emacs 23 or later:
853 - `confirm' means the user can exit with any input, but if the input
854 is not an element of COLLECTION then confirmation is needed.
855 - `confirm-after-completion' is similar, except that with
856 non-matching input exit is allowed only just after completing.
857 * Anything else behaves like t, except that hitting `\\[exit-minibuffer]' does not
858 exit if it performs non-null completion.
860 Regardless of the value of REQUIRE-MATCH, if the user input is empty,
861 then `completing-read' returns DEF or, if DEF is nil, an empty string.
863 If option `icicle-require-match-flag' is non-nil, it overrides the
864 value of REQUIRE-MATCH.
866 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
867 with point positioned at the end. If it is (STRING . POSITION), the
868 initial input is STRING, but point is placed at zero-indexed position
869 POSITION in STRING. (This is different from `read-from-minibuffer'
870 and related functions, which use one-indexing for POSITION.)
872 INITIAL-INPUT is considered deprecated by vanilla Emacs, but not by
873 Icicles. If INITIAL-INPUT is nil and DEF is non-nil, the user can use
874 `next-history-element' to yank DEF into the minibuffer.
876 HIST, if non-nil, specifies a history list and optionally the initial
877 position in the list. It can be a symbol, which is the history list
878 variable to use, or it can be a cons cell (HISTVAR . HISTPOS). If a
879 cons cell, HISTVAR is the history list variable to use, and HISTPOS is
880 the initial position (the position in the list used by the minibuffer
881 history commands). For consistency, you should also specify that
882 element of the history as the value of INITIAL-INPUT. Positions are
883 counted starting from 1 at the beginning of the list. The variable
884 `history-length' controls the maximum length of a history list.
886 DEF, if non-nil, is the default value or (Emacs 23+ only) the list of
887 default values. Option `icicle-default-value' controls the treatment
888 of the default value (or the first default value, if DEF is a list):
889 whether it is shown in the prompt, substituted for an empty
890 INITIAL-INPUT, and so on.
892 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits the
893 current input method and the setting of `enable-multibyte-characters'.
895 Both completion candidates and DEF are filtered using these Icicles
897 `icicle-must-match-regexp'
898 `icicle-must-not-match-regexp'
899 `icicle-must-pass-predicate'
901 Completion ignores case when `completion-ignore-case' is non-nil."
902 (unless (stringp icicle-initial-value) (setq icicle-initial-value "")) ; Convert nil to "".
903 (unless initial-input (setq initial-input icicle-initial-value))
904 (if (consp initial-input)
905 (setq icicle-initial-value (car initial-input))
906 (setq initial-input (format "%s" initial-input) ; Convert symbol to string
907 icicle-initial-value initial-input))
908 (setq icicle-nb-of-other-cycle-candidates 0)
910 ;; Use DEF for INITIAL-INPUT also, if `icicle-default-value' says so.
911 (when (and def icicle-default-value (not (eq icicle-default-value t))
912 (stringp initial-input) (string= "" initial-input))
913 ;; Filter DEF using `icicle-filter-wo-input'. Done in `read-from-minibuffer' anyway, but we
914 ;; must also do it here, to reuse the correct default value for the init value.
916 (setq initial-input (or (icicle-filter-wo-input def) "")) ; Ensure that it is non-nil.
919 (while (and (not found) def1)
920 (setq found (icicle-filter-wo-input (car def1))
922 (setq initial-input (or found ""))))
923 (when (memq icicle-default-value '(insert-start preselect-start))
924 (setq initial-input (cons initial-input 0))))
926 ;; Override REQUIRE-MATCH as needed.
927 (setq require-match (case icicle-require-match-flag
928 ((nil) require-match)
929 (no-match-required nil)
931 (full-match-required 'full-match-required))
932 icicle-require-match-p require-match)
933 (icicle-highlight-lighter)
934 (let* ((minibuffer-history-variable minibuffer-history-variable)
935 ;; $$$$$$$$$$ `minibuffer-completion-table' binding needed? `setq' in `*-lisp-vanilla-*'.
936 (minibuffer-allow-text-properties t) ; This is nil for completion in vanilla Emacs.
937 (minibuffer-completion-table collection)
938 (icicle-fancy-cands-internal-p (or icicle-whole-candidate-as-text-prop-p
939 icicle-fancy-candidates-p
941 0 'icicle-fancy-candidates prompt)))
943 ;; Transform a cons collection to what is expected for `minibuffer-completion-table'.
944 (when icicle-fancy-cands-internal-p
945 (let ((c+p (icicle-mctize-all collection predicate)))
946 (setq collection (car c+p) ; After banalizing for vanilla Emacs.
947 predicate (cadr c+p))))
948 ;; $$$$$$$$$$$$$ (setq minibuffer-completion-table collection)
949 (cond ((not icicle-mode)
950 (setq result (icicle-lisp-vanilla-completing-read
951 prompt collection predicate require-match initial-input
952 hist-m@%=!$+&^*z def inherit-input-method)))
954 (let ((minibuffer-prompt-properties
955 (and (boundp 'minibuffer-prompt-properties) ; Emacs 21+ only
956 (icicle-remove-property 'face minibuffer-prompt-properties)))
957 (minibuffer-completing-file-name
958 ;; Can't be file-name completion unless it's a function.
959 (and (functionp collection) minibuffer-completing-file-name)))
960 (when (< emacs-major-version 21)
961 (setq prompt (concat (and icicle-candidate-action-fn "+ ") prompt)))
962 (setq result (catch 'icicle-read-top
963 (icicle-lisp-vanilla-completing-read
964 prompt collection predicate require-match initial-input
965 hist-m@%=!$+&^*z def inherit-input-method)))
966 (icicle-unpropertize result))))
967 ;; HACK. Without this, when REQUIRE-MATCH is non-nil, `*Completions*' window
968 ;; does not disappear.
969 (when require-match (icicle-remove-Completions-window))
972 (defun icicle-mctize-all (coll pred)
973 "Transform collection COLL and predicate PRED for vanilla completion.
974 COLL is an Icicles collection argument acceptable to
975 `icicle-completing-read' but not necessarily to vanilla
976 `completing-read': COLL can contain multi-completions.
979 Returns a new two-element list of the new collection and predicate:
980 \(MCT NEWPRED), where MCT is COLL transformed and NEWPRED is PRED
981 transformed. MCT is a collection suitable for vanilla
984 COLL is transformed to MCT by applying `icicle-mctized-full-candidate'
985 to each of its elements.
987 If PRED is non-nil, then NEWPRED is a predicate that applies PRED to
988 the cdr of an MCT entry. If PRED is nil, so is NEWPRED."
990 ;; Copy alist collection COLL, so we don't change the original alist in any way.
991 ;; Change each entry in COLL using `icicle-mctized-full-candidate'.
992 (setq coll (mapcar #'icicle-mctized-full-candidate coll))
993 ;; Convert non-nil PRED so that, for a cons entry with a string car, PRED uses the cdr
994 ;; (which is the original entry) instead.
995 (and pred (lexical-let ((new-pred pred))
996 (setq pred (lambda (x)
997 (funcall new-pred (if (and (consp x) (stringp (car x))) (cdr x) x)))))))
1000 (defun icicle-mctized-full-candidate (cand)
1001 "Return MCT candidate that corresponds to full candidate CAND.
1002 See the source code for details."
1003 ;; If neither `icicle-fancy-cands-internal-p' nor `icicle-whole-candidate-as-text-prop-p' is
1004 ;; non-nil, then just return CAND.
1006 ;; If CAND is a string A, we change it to (A) and then treat that (as follows).
1007 ;; If CAND is (A . B), where A is a string, then we change it to (S A . B), where S is a copy
1008 ;; of A. This way, the cdr of each MCT candidate is the original alist candidate, (A . B).
1009 ;; If CAND is (M . B), where M is a multi-completion (X Y Z...), then we change it to
1010 ;; (M' A . B), where M' is the display string for the multi-completion M.
1011 ;; Otherwise, we make no change to CAND.
1012 ;; If `icicle-whole-candidate-as-text-prop-p' is non-nil and the MCT candidate is a cons (X A . B)
1013 ;; with a string car X, then we put the cdr, (A . B), as a text property on the car X, so
1014 ;; we can get back the original (A . B) from the car.
1015 (if (not (or icicle-fancy-cands-internal-p icicle-whole-candidate-as-text-prop-p))
1018 (cond ((and (consp cand) ; Multi-completion: (("aa" "bb") . cc) ->
1019 (consp (car cand)) ; ("aa^G\nbb\n\n" ("aa" "bb") . cc)
1020 (stringp (caar cand)))
1022 ;; (when (string-match "\n" icicle-list-join-string)
1023 ;; (setq icicle-completions-format-internal 'horizontal)) ; Override
1024 ;; $$$$$$ (cons (concat (mapconcat #'identity (car cand) icicle-list-join-string)
1025 ;; icicle-list-end-string) ; $$$$$$
1026 (cons (mapconcat #'identity (car cand) icicle-list-join-string) cand))
1027 ((and (consp cand) (stringp (car cand))) ; ("aa" . cc) -> ("aa" "aa" . cc)
1028 (cons (copy-sequence (car cand)) cand))
1029 ((stringp cand) ; "aa" -> ("aa" "aa")
1030 (list (copy-sequence cand) cand))
1031 (t ; Anything else: (aa), aa -> no change
1033 ;; Put original alist candidates on display candidates (strings), as a text property.
1034 (when (and icicle-whole-candidate-as-text-prop-p (consp new-cand) (stringp (car new-cand)))
1035 (icicle-put-whole-cand-prop new-cand))
1038 (defun icicle-put-whole-cand-prop (cand)
1039 "Put cdr of CAND on its car, as text property `icicle-whole-candidate'.
1040 This has no side effects.
1041 Returns a new propertized string corresponding to (car CAND)."
1042 (let ((text-cand (copy-sequence (car cand))))
1043 (put-text-property 0 (length text-cand) 'icicle-whole-candidate (cdr cand) text-cand)
1044 (setcar cand text-cand)
1047 (defun icicle-mctized-display-candidate (cand)
1048 "Return MCT candidate that corresponds to display candidate CAND."
1049 (let ((full-cand (or (funcall icicle-get-alist-candidate-function cand) (list cand))))
1050 (cons cand full-cand)))
1052 (defun icicle-replace-mct-cand-in-mct (old new)
1053 "Replace OLD candidate with NEW in `minibuffer-completion-table'.
1054 Both OLD and NEW have been mctized. That is, they are ready for
1055 `minibuffer-completion-table'."
1056 (let ((newlist minibuffer-completion-table))
1057 (catch 'icicle-replace-cand-in-mct
1059 (when (equal (car newlist) old)
1060 (setcar newlist new)
1061 (throw 'icicle-replace-cand-in-mct nil))
1062 (setq newlist (cdr newlist))))
1063 minibuffer-completion-table))
1065 (defun icicle-read-file-name (prompt &optional dir default-filename
1066 require-match initial-input predicate)
1067 "Read file name, prompting with PROMPT and completing in directory DIR.
1068 Value is not expanded---you must call `expand-file-name' yourself.
1069 DIR should be an absolute directory name. It defaults to the value of
1070 `default-directory'.
1071 Default the name to DEFAULT-FILENAME if user exits the minibuffer with
1072 the same non-empty string that was inserted by this function.
1073 (If DEFAULT-FILENAME is omitted, the visited file name is used,
1074 but if INITIAL-INPUT is specified, that combined with DIR is used.)
1075 If the user exits with an empty minibuffer, this function returns
1076 an empty string. (This can only happen if the user erased the
1077 pre-inserted contents or if `insert-default-directory' is nil.)
1078 Fourth arg REQUIRE-MATCH non-nil means require existing file's name.
1079 Non-nil and non-t means also require confirmation after completion.
1080 Fifth arg INITIAL-INPUT specifies text to start with.
1081 If optional sixth arg PREDICATE is non-nil, possible completions and
1082 the resulting file name must satisfy `(funcall predicate NAME)'.
1083 This argument is only available starting with Emacs 22.
1085 Both completion candidates and DEFAULT-FILENAME are filtered using
1086 these Icicles variables:
1087 `icicle-must-match-regexp'
1088 `icicle-must-not-match-regexp'
1089 `icicle-must-pass-predicate'
1091 Directory names are highlighted in `*Completions*' using face
1092 `icicle-special-candidate'.
1094 If option `icicle-require-match-flag' is non-nil, it overrides the
1095 value of REQUIRE-MATCH.
1097 Cycling into subdirectories is determined by option
1098 `icicle-cycle-into-subdirs-flag'. Case is ignored if
1099 `read-file-name-completion-ignore-case' is non-nil. See also
1100 `read-file-name-function'.
1102 If option `icicle-add-proxy-candidates-flag' is non-nil, then the
1103 following proxy file-name candidates are included. (This inclusion
1104 can be toggled at any time from the minibuffer, using `C-M-_'.)
1106 * `*mouse-2 file name*' - Click `mouse-2' on a file name to choose it.
1107 * `*point file name*' - Use the file name at point (cursor).
1108 * Single-quoted file-name variables - Use the variable's value.
1110 Candidates `*mouse-2 file name*' and `*point file name*' are available
1111 only if library `ffap.el' can be loaded. A file-name variable has
1112 custom type `file' or (file :must-match t).
1114 If this command was invoked with the mouse, use a file dialog box if
1115 `use-dialog-box' is non-nil, and the window system or X toolkit in use
1116 provides a file dialog box.
1118 See also `read-file-name-completion-ignore-case' (Emacs version > 21)
1119 and `read-file-name-function'."
1121 (let* ((mouse-file "*mouse-2 file name*")
1122 (icicle-special-candidate-regexp (or icicle-special-candidate-regexp ".+/$"))
1123 (minibuffer-completing-file-name t)
1124 (read-file-name-predicate (and (boundp 'read-file-name-predicate)
1125 read-file-name-predicate))
1126 (ffap-available-p (or (require 'ffap- nil t) (require 'ffap nil t)))
1127 ;; The next four prevent slowing down `ffap-guesser'.
1128 (ffap-alist nil) (ffap-machine-p-known 'accept)
1129 (ffap-url-regexp nil) (ffap-shell-prompt-regexp nil)
1131 (if (and (eq major-mode 'dired-mode) (fboundp 'dired-get-file-for-visit))
1133 (abbreviate-file-name (dired-get-file-for-visit))
1135 (and ffap-available-p (ffap-guesser))))
1136 (icicle-proxy-candidates
1138 (and icicle-add-proxy-candidates-flag
1139 (append (and fap (list "*point file name*"))
1140 (and ffap-available-p (list mouse-file))
1144 (when (and (user-variable-p cand)
1146 (icicle-var-is-of-type-p cand
1147 '(file (file :must-match t)))
1149 (push (concat "'" (symbol-name cand) "'") ipc))))
1151 icicle-proxy-candidates))
1154 ;; ;; $$$$$$ Does Emacs 23+ need explicit directory? If so, add these three lines
1155 ;; (unless dir (setq dir default-directory))
1156 ;; (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
1157 ;; (setq dir (abbreviate-file-name dir)) ; Use `~' for home directory.
1159 (setq result (icicle-read-file-name-1 prompt dir default-filename
1160 require-match initial-input predicate))
1161 (when ffap-available-p
1162 (cond ((save-match-data (string-match "*point file name\\*$" result))
1164 ((save-match-data (string-match "*mouse-2 file name\\*$" result))
1166 (progn (let ((e (read-event "Click `mouse-2' on file name")))
1167 (read-event) ; Get rid of mouse up event.
1170 (if (and (eq major-mode 'dired-mode)
1171 (fboundp 'dired-get-file-for-visit)) ; In `dired+.el'.
1172 (condition-case nil ; E.g. error: not on file line (ignore)
1173 (abbreviate-file-name (dired-get-file-for-visit))
1174 (error "No such file"))
1175 (or (ffap-guesser) (error "No such file"))))))))))
1176 (icicle-unpropertize result)
1177 (let* ((temp (member (file-name-nondirectory result) icicle-proxy-candidates))
1178 (symb (and temp (intern (substring (car temp) 1 (1- (length (car temp))))))))
1179 (when (and symb (boundp symb)) (setq result (symbol-value symb))))
1181 (setq icicle-proxy-candidates ())))
1183 (defun icicle-read-file-name-1 (prompt &optional dir default-filename
1184 require-match initial-input predicate)
1185 "Helper function for `icicle-read-file-name'."
1186 (setq icicle-nb-of-other-cycle-candidates 0
1187 icicle-initial-value (or initial-input (if (stringp icicle-initial-value)
1188 icicle-initial-value
1190 (icicle-fix-default-directory) ; Make sure there are no backslashes in it.
1191 (unless (string= "" icicle-initial-value) (setq initial-input icicle-initial-value))
1193 ;; Use DEFAULT-FILENAME for INITIAL-INPUT also, if `icicle-default-value' says so.
1194 ;; But if so, remove the directory part first.
1195 ;; Note that if DEFAULT-FILENAME is null, then we let INITIAL-INPUT remain null too.
1196 (when (and default-filename icicle-default-value (not (eq icicle-default-value t))
1197 ;; We don't use the same test as for `completing-read':
1198 ;; (stringp initial-input) (string= "" initial-input))
1199 (string= "" icicle-initial-value))
1200 ;; Filter DEFAULT-FILENAME using `icicle-filter-wo-input'. Done in `read-from-minibuffer'
1201 ;; anyway, but we must also do it here, to reuse the correct default value for the init value.
1202 (if (atom default-filename)
1203 (setq initial-input (icicle-filter-wo-input (file-name-nondirectory default-filename)))
1205 (def1 default-filename))
1206 (while (and (not found) def1)
1207 (setq found (icicle-filter-wo-input (file-name-nondirectory (car def1)))
1209 (setq initial-input (or found "")))))
1211 ;; Override REQUIRE-MATCH as needed.
1212 (setq require-match (case icicle-require-match-flag
1213 ((nil) require-match)
1214 (no-match-required nil)
1215 (partial-match-ok t)
1216 (full-match-required 'full-match-required))
1217 icicle-require-match-p require-match)
1218 (icicle-highlight-lighter)
1219 (let ((read-file-name-function nil)
1220 (minibuffer-history-variable minibuffer-history-variable)
1222 (let ((minibuffer-prompt-properties
1223 (and (boundp 'minibuffer-prompt-properties) ; Emacs 21+ only
1224 (icicle-remove-property 'face minibuffer-prompt-properties))))
1225 (when (< emacs-major-version 21)
1226 (setq prompt (concat (and icicle-candidate-action-fn "+ ") prompt)))
1227 (condition-case nil ; If Emacs 22+, use predicate arg.
1228 (setq result (catch 'icicle-read-top
1229 (funcall (or icicle-old-read-file-name-fn 'read-file-name) prompt dir
1230 default-filename require-match initial-input predicate)))
1231 (wrong-number-of-arguments
1232 (setq result (catch 'icicle-read-top
1233 (funcall (or icicle-old-read-file-name-fn 'read-file-name) prompt dir
1234 default-filename require-match initial-input))))))
1235 ;; HACK. Without this, when REQUIRE-MATCH is non-nil, `*Completions*' window
1236 ;; does not disappear.
1237 (when require-match (icicle-remove-Completions-window))
1240 (defun icicle-fix-default-directory ()
1241 "Convert backslashes in `default-directory' to slashes."
1242 ;; This is a hack. If you do `C-x 4 f' from a standalone minibuffer
1243 ;; frame, `default-directory' on MS Windows has this form:
1244 ;; `C:\some-dir/'. There is a backslash character in the string. This
1245 ;; is not a problem for standard Emacs, but it is a problem for Icicles,
1246 ;; because we interpret backslashes using regexp syntax - they are not
1247 ;; file separators for Icicles. So, we call `substitute-in-file-name' to
1248 ;; change all backslashes in `default-directory' to slashes. This
1249 ;; shouldn't hurt, because `default-directory' is an absolute directory
1250 ;; name - it doesn't contain environment variables. For example, we
1251 ;; convert `C:\some-dir/' to `c:/some-directory/'."
1252 (setq default-directory (icicle-abbreviate-or-expand-file-name
1253 (substitute-in-file-name default-directory))))
1255 (defun icicle-remove-property (prop plist)
1256 "Remove property PROP from property-list PLIST, non-destructively.
1257 Returns the modified copy of PLIST."
1261 (unless (eq prop (car cpy)) (setq result `(,(cadr cpy) ,(car cpy) ,@result)))
1262 (setq cpy (cddr cpy)))
1266 ;; REPLACE ORIGINAL `read-from-minibuffer' (built-in function),
1267 ;; saving it for restoration when you toggle `icicle-mode'.
1269 ;; Respect `icicle-default-value'.
1271 ;; We use HIST-m@%=!$+&^*z instead of HIST, to avoid name capture by `minibuffer-history-variable's
1272 ;; value. If we didn't need to be Emacs 20-compatible, then we could employ
1273 ;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
1275 (unless (fboundp 'old-read-from-minibuffer)
1276 (defalias 'old-read-from-minibuffer (symbol-function 'read-from-minibuffer)))
1278 (defun icicle-read-from-minibuffer (prompt &optional initial-contents keymap read
1279 hist-m@%=!$+&^*z default-value inherit-input-method)
1280 "Read a string from the minibuffer, prompting with string PROMPT.
1281 The optional second arg INITIAL-CONTENTS is an alternative to
1282 DEFAULT-VALUE. Vanilla Emacs considers it to be obsolete, but
1283 Icicles does not. It is discussed in more detail below.
1284 Third arg KEYMAP is a keymap to use while reading;
1285 if omitted or nil, the default is `minibuffer-local-map'.
1286 If fourth arg READ is non-nil, then interpret the result as a Lisp object
1287 and return that object:
1288 in other words, do `(car (read-from-string INPUT-STRING))'
1289 Fifth arg HIST, if non-nil, specifies a history list and optionally
1290 the initial position in the list. It can be a symbol, which is the
1291 history list variable to use, or it can be a cons cell
1292 (HISTVAR . HISTPOS). In that case, HISTVAR is the history list variable
1293 to use, and HISTPOS is the initial position for use by the minibuffer
1294 history commands. For consistency, you should also specify that
1295 element of the history as the value of INITIAL-CONTENTS. Positions
1296 are counted starting from 1 at the beginning of the list.
1297 Sixth arg DEFAULT-VALUE is the default value. If non-nil, it is available
1298 for history commands; but, unless READ is non-nil, `read-from-minibuffer'
1299 does NOT return DEFAULT-VALUE if the user enters empty input! It returns
1300 the empty string. DEFAULT-VALUE can be a string or a list of strings.
1301 These become the minibuffer's future history, available using `M-n'.
1302 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1303 the current input method and the setting of `enable-multibyte-characters'.
1304 Eighth arg KEEP-ALL, if non-nil, says to put all inputs in the history list,
1305 even empty or duplicate inputs. This is available starting with Emacs 22.
1306 If the variable `minibuffer-allow-text-properties' is non-nil,
1307 then the string which is returned includes whatever text properties
1308 were present in the minibuffer. Otherwise the value has no text properties.
1310 Option `icicle-default-value' controls how the default value,
1311 DEFAULT-VALUE, is treated.
1313 The remainder of this documentation string describes the
1314 INITIAL-CONTENTS argument in more detail. If non-nil,
1315 INITIAL-CONTENTS is a string to be inserted into the minibuffer before
1316 reading input. Normally, point is put at the end of that string.
1317 However, if INITIAL-CONTENTS is (STRING . POSITION), the initial input
1318 is STRING, but point is placed at one-indexed position POSITION in the
1319 minibuffer. Any integer value less than or equal to one puts point at
1320 the beginning of the string. *Note* that this behavior differs from
1321 the way such arguments are used in `completing-read' and some related
1322 functions, which use zero-indexing for POSITION."
1323 (unless initial-contents (setq initial-contents ""))
1325 ;; Filter DEFAULT-VALUE using `icicle-filter-wo-input'.
1328 (if (atom default-value)
1329 (icicle-filter-wo-input default-value)
1330 (delq nil (mapcar #'icicle-filter-wo-input default-value))))) ; Emacs 23 accepts a list.
1331 ;; Save new default value for caller (e.g. `icicle-lisp-vanilla-completing-read'.
1332 (setq icicle-filtered-default-value default-value)
1334 ;; If a list of strings, use the first one for prompt etc.
1335 (let ((def-value (if (consp default-value) (car default-value) default-value)))
1336 ;; Maybe use DEFAULT-VALUE for INITIAL-CONTENTS also.
1337 (when (and icicle-default-value (not (eq icicle-default-value t))
1338 def-value (stringp initial-contents) (string= "" initial-contents))
1339 (setq initial-contents (if (integerp def-value) ; Character
1340 (char-to-string def-value)
1342 (when (and def-value (eq icicle-default-value t)) ; Add DEFAULT-VALUE to PROMPT.
1343 (when (icicle-file-name-input-p) (setq def-value (file-name-nondirectory def-value)))
1344 (setq prompt (if (string-match "\\(.*\\)\\(: *\\)$" prompt)
1345 (concat (substring prompt (match-beginning 1) (match-end 1)) " (" def-value
1346 ")" (substring prompt (match-beginning 2) (match-end 2)))
1347 (concat prompt def-value)))))
1348 (old-read-from-minibuffer
1349 prompt initial-contents keymap read hist-m@%=!$+&^*z default-value inherit-input-method))
1352 ;; REPLACE ORIGINAL `minibuffer-default-add-completions' defined in `simple.el',
1353 ;; saving it for restoration when you toggle `icicle-mode'.
1355 ;; Respect Icicles global filters, so you don't see, as defaults, candidates that were filtered out.
1357 (when (fboundp 'minibuffer-default-add-completions) ; Emacs 23+.
1358 (unless (fboundp 'old-minibuffer-default-add-completions)
1359 (defalias 'old-minibuffer-default-add-completions
1360 (symbol-function 'minibuffer-default-add-completions)))
1362 ;; Use this as `minibuffer-default-add-function'.
1363 (defun icicle-minibuffer-default-add-completions ()
1364 "Like `old-minibuffer-default-add-completions', but respect global filters."
1365 (let ((def minibuffer-default)
1366 (all (icicle-all-completions "" minibuffer-completion-table
1367 minibuffer-completion-predicate 'HIDE-SPACES)))
1368 (setq all (icicle-remove-if-not (lambda (cand)
1369 (let ((case-fold-search completion-ignore-case))
1370 (icicle-filter-wo-input cand)))
1374 (cons def (delete def all))))))
1377 ;; REPLACE ORIGINAL `read-number' defined in `subr.el',
1378 ;; saving it for restoration when you toggle `icicle-mode'.
1379 ;; 1. Let user enter a numeric variable name, for its value. Allow completion.
1380 ;; 2. Allow for error reading input.
1381 ;; 3. Call `ding' if not a number, and don't redisplay for `sit-for'.
1383 (when (fboundp 'read-number) ; Emacs 22+
1384 (unless (fboundp 'old-read-number)
1385 (defalias 'old-read-number (symbol-function 'read-number)))
1387 (defun icicle-read-number (prompt &optional default)
1388 "Read a number in the minibuffer, prompting with PROMPT (a string).
1389 DEFAULT is returned if the user hits `RET' without typing anything.
1391 If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
1392 also enter the name of a numeric variable - its value is returned.
1393 Completion is available for this. A numeric variable is a variable
1394 whose value or whose custom type is compatible with type `integer',
1395 `number', or `float'."
1398 (icicle-proxy-candidates
1399 (and icicle-add-proxy-candidates-flag
1403 (when (and (user-variable-p cand)
1405 (icicle-var-is-of-type-p cand (if (>= emacs-major-version 22)
1406 '(number integer float)
1409 (push (symbol-name cand) ipc))))
1412 ;; Emacs 23 allows DEFAULT to be a list of strings - use the first one for prompt etc.
1413 (default1 (if (consp default) (car default) default)))
1416 (setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt)
1417 (replace-match (format " (default %s)" default1) t t prompt 1)
1418 (replace-regexp-in-string
1419 "[ \t]*\\'" (format " (default %s) " default1) prompt t t)))))
1420 (when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
1422 (let ((str (completing-read prompt nil nil nil nil nil
1424 (mapcar #'number-to-string default)
1425 (and default1 (number-to-string default1)))))
1427 (setq num (cond ((zerop (length str)) default1)
1428 ((setq temp (member str icicle-proxy-candidates))
1429 (symbol-value (intern (car temp))))
1430 ((stringp str) (condition-case nil (read str) (error nil))))))
1431 (unless (numberp num)
1432 (icicle-ding) (message "Not a number. Try again.") (sit-for 0.5 nil t)
1435 (setq icicle-proxy-candidates ()))))
1437 ;; Can't replace standard `read-char-exclusive' with this, because, starting with Emacs 22, it has
1438 ;; an optional SECONDS arg that cannot be simulated using `completing-read'.
1439 (defun icicle-read-char-exclusive (prompt &optional inherit-input-method)
1440 "Read a character in the minibuffer, prompting with PROMPT (a string).
1441 It is returned as a number.
1442 Optional arg INHERIT-INPUT-METHOD is as for `completing-read'.
1444 If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
1445 also enter the name of a character variable - its value is returned.
1446 Completion is available for this. A character variable is a variable
1447 whose value is compatible with type `character'."
1450 (icicle-proxy-candidates
1451 (and icicle-add-proxy-candidates-flag
1453 (mapatoms (lambda (cand)
1454 (when (and (user-variable-p cand)
1456 (icicle-var-is-of-type-p cand '(character))
1458 (push (symbol-name cand) ipc))))
1461 (when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
1462 (setq str (completing-read prompt nil nil nil nil nil nil inherit-input-method)
1463 char (cond ((zerop (length str)) (error "No character read"))
1464 ((setq temp (member str icicle-proxy-candidates))
1465 (symbol-value (intern (car temp))))
1466 ((stringp str) (condition-case nil
1467 (progn (when (> (length str) 1)
1468 (message "First char is used: `%c'"
1469 (elt str 0)) (sit-for 2))
1473 (setq icicle-proxy-candidates ())))
1475 (defun icicle-read-string-completing (prompt &optional default pred hist)
1476 "Read a string in the minibuffer, prompting with PROMPT (a string).
1477 If the user hits `RET' without typing anything, return DEFAULT, or \"\"
1479 PRED is a predicate that filters the variables available for completion.
1480 HIST is the history list to use, as for `completing-read'.
1482 If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
1483 also enter the name of a string variable - its value is returned.
1484 Completion is available for this. A string variable is a variable
1485 whose value or whose custom type is compatible with type `string'."
1488 (icicle-proxy-candidates
1489 (and icicle-add-proxy-candidates-flag
1491 (mapatoms (lambda (cand)
1492 (when (and (user-variable-p cand)
1494 (icicle-var-is-of-type-p cand '(string color regexp))
1496 (push (symbol-name cand) ipc))))
1498 ;; Emacs 23 allows DEFAULT to be a list of strings - use the first one for prompt etc.
1499 (default1 (if (consp default) (car default) default)))
1502 (setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt)
1503 (replace-match (format " (default %s)" default1) t t prompt 1)
1504 (replace-regexp-in-string
1505 "[ \t]*\\'" (format " (default %s) " default1) prompt t t)))))
1506 (when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
1507 (let ((strg-read (completing-read prompt nil pred nil
1509 (nth (cdr hist) (symbol-value (car hist))))
1512 (setq strg (cond ((zerop (length strg-read)) (or default1 ""))
1513 ((setq temp (member strg-read icicle-proxy-candidates))
1514 (setq temp (symbol-value (intern (car temp))))
1515 (cond ((and (symbolp hist) (consp (symbol-value hist)))
1516 (setcar (symbol-value hist) temp))
1517 ((and (consp hist) (symbolp (car hist))
1518 (consp (symbol-value (car hist))))
1519 (setcar (symbol-value (car hist)) temp)))
1523 (setq icicle-proxy-candidates ())))
1525 ;; Same as `help-var-is-of-type-p'.
1526 (defun icicle-var-is-of-type-p (variable types &optional mode)
1527 "Return non-nil if VARIABLE satisfies one of the custom types in TYPES.
1528 TYPES is a list of `defcustom' type sexps or a list of regexp strings.
1529 TYPES are matched, in order, against VARIABLE's type definition or
1530 VARIABLE's current value, until one is satisfied or all are tried.
1532 If TYPES is a list of regexps, then each is regexp-matched against
1533 VARIABLE's custom type.
1535 Otherwise, TYPES is a list of type sexps, each of which is a
1536 definition acceptable for `defcustom' :type or the first symbol of
1537 such a definition (e.g. `choice'). In this case, two kinds of type
1538 comparison are possible:
1540 1. VARIABLE's custom type, or its first symbol, is matched using
1541 `equal' against each type in TYPES.
1543 2. VARIABLE's current value is checked against each type in TYPES to
1544 see if it satisfies one of them. In this case, VARIABLE's own type
1545 is not used; VARIABLE might not even be typed - it could be a
1546 variable not defined using `defcustom'.
1548 For any of the comparisons against VARIABLE's type, either that type
1549 can be checked directly or its supertypes (inherited types) can also
1552 These different type-checking possibilities depend on the value of
1553 argument MODE, as follows, and they determine the meaning of the
1556 `direct': VARIABLE's type matches a member of list TYPES
1557 `inherit': VARIABLE's type matches or is a subtype of a TYPES member
1558 `value': VARIABLE is bound, and its value satisfies a type in TYPES
1559 `inherit-or-value': `inherit' or `value', tested in that order
1560 `direct-or-value': `direct' or `value', tested in that order
1561 anything else (default): `inherit'
1563 VARIABLE's current value cannot satisfy a regexp type: it is
1564 impossible to know which concrete types a value must match."
1566 ((nil inherit) (icicle-var-inherits-type-p variable types))
1567 (inherit-or-value (or (icicle-var-inherits-type-p variable types)
1568 (icicle-var-val-satisfies-type-p variable types)))
1569 (value (icicle-var-val-satisfies-type-p variable types))
1570 (direct (icicle-var-matches-type-p variable types))
1571 (direct-or-value (or (member (get variable 'custom-type) types)
1572 (icicle-var-val-satisfies-type-p variable types)))
1573 (otherwise (icicle-var-inherits-type-p variable types))))
1575 (defun icicle-var-matches-type-p (variable types)
1576 "VARIABLE's type matches a member of TYPES."
1577 (catch 'icicle-type-matches
1578 (let ((var-type (get variable 'custom-type)))
1579 (dolist (type types)
1580 (when (if (stringp type)
1581 (save-match-data (string-match type (format "%s" (format "%S" var-type))))
1582 (equal var-type type))
1583 (throw 'icicle-type-matches t))))
1586 (defun icicle-var-inherits-type-p (variable types)
1587 "VARIABLE's type matches or is a subtype of a member of list TYPES."
1588 (catch 'icicle-type-inherits
1589 (let ((var-type (get variable 'custom-type)))
1590 (dolist (type types)
1592 (when (or (and (stringp type)
1593 (save-match-data (string-match type (format "%s" (format "%S" var-type)))))
1594 (equal type var-type))
1595 (throw 'icicle-type-inherits t))
1596 (when (consp var-type) (setq var-type (car var-type)))
1597 (when (or (and (stringp type)
1598 (save-match-data (string-match type (format "%s" (format "%S" var-type)))))
1599 (equal type var-type))
1600 (throw 'icicle-type-inherits t))
1601 (setq var-type (car (get var-type 'widget-type))))
1602 (setq var-type (get variable 'custom-type))))
1605 (defun icicle-var-val-satisfies-type-p (variable types)
1606 "VARIABLE is bound, and its value satisfies a type in the list TYPES."
1607 (and (boundp variable)
1608 (let ((val (symbol-value variable)))
1609 (and (widget-convert (get variable 'custom-type))
1610 (icicle-value-satisfies-type-p val types)))))
1612 (defun icicle-value-satisfies-type-p (value types)
1613 "Return non-nil if VALUE satisfies a type in the list TYPES."
1614 (catch 'icicle-type-value-satisfies
1615 (dolist (type types)
1616 (unless (stringp type) ; Skip, for regexp type.
1617 (setq type (widget-convert type))
1618 ;; Satisfies if either :match or :validate.
1619 (when (condition-case nil
1620 (progn (when (and (widget-get type :match) (widget-apply type :match value))
1621 (throw 'icicle-type-value-satisfies t))
1622 (when (and (widget-get type :validate)
1623 (progn (widget-put type :value value)
1624 (not (widget-apply type :validate))))
1625 (throw 'icicle-type-value-satisfies t)))
1627 (throw 'icicle-type-value-satisfies t))))
1630 (defun icicle-custom-type (variable)
1631 "Returns the `defcustom' type of VARIABLE.
1632 Returns nil if VARIABLE is not a user option.
1634 Note: If the library that defines VARIABLE has not yet been loaded,
1635 then `icicle-custom-type' loads it. Be sure you want to do that
1636 before you call this function."
1637 (and (custom-variable-p variable)
1638 (or (get variable 'custom-type)
1639 (progn (custom-load-symbol variable) (get variable 'custom-type)))))
1642 ;; REPLACE ORIGINAL `read-string' (built-in function),
1643 ;; saving it for restoration when you toggle `icicle-mode'.
1645 ;; Respect `icicle-default-value' (via use of `read-from-minibuffer').
1647 ;; We use HIST-m@%=!$+&^*z instead of HISTORY, to avoid name capture by `minibuffer-history-variable's
1648 ;; value. If we didn't need to be Emacs 20-compatible, then we could employ
1649 ;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
1651 (unless (fboundp 'old-read-string)
1652 (defalias 'old-read-string (symbol-function 'read-string)))
1654 (defun icicle-read-string (prompt &optional initial-input hist-m@%=!$+&^*z
1655 default-value inherit-input-method)
1656 "Read a string from the minibuffer, prompting with string PROMPT.
1657 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
1658 Vanilla Emacs considers it to be obsolete, but Icicles does not. It
1659 behaves like argument INITIAL-CONTENTS in `read-from-minibuffer'.
1660 See the documentation string of `read-from-minibuffer' for details.
1661 The third arg HISTORY, if non-nil, specifies a history list
1662 and optionally the initial position in the list.
1663 See `read-from-minibuffer' for details of HISTORY argument.
1664 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
1665 for history commands, and as the value to return if the user enters
1667 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
1668 the current input method and the setting of enable-multibyte-characters."
1669 (let ((value (read-from-minibuffer prompt initial-input nil nil hist-m@%=!$+&^*z
1670 default-value inherit-input-method)))
1671 (when (and default-value (equal value ""))
1672 (setq value (if (consp default-value) (car default-value) default-value)))
1676 ;; REPLACE ORIGINAL `read-face-name' in `faces.el',
1677 ;; saving it for restoration when you toggle `icicle-mode'.
1679 ;; Show face names in `*Completions*' with the faces they name.
1681 (unless (fboundp 'old-read-face-name)
1682 (defalias 'old-read-face-name (symbol-function 'read-face-name)))
1684 (cond ((< emacs-major-version 21)
1685 (defun icicle-read-face-name (prompt) ; Emacs 20
1686 "Read a face name with completion and return its face symbol.
1687 PROMPT is the prompt.
1689 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
1690 also enter the name of a face-name variable - its value is returned.
1691 A face-name variable is a variable with custom-type `face'.
1693 If library `eyedropper.el' is used, then you can also choose proxy
1694 candidate `*point face name*' to use the face at point."
1695 (require 'eyedropper nil t)
1696 (let ((icicle-list-nth-parts-join-string ": ")
1697 (icicle-list-join-string ": ")
1698 ;; $$$$$$ (icicle-list-end-string "")
1699 (icicle-list-use-nth-parts '(1))
1700 (icicle-proxy-candidates
1701 (and icicle-add-proxy-candidates-flag
1702 (append (and (fboundp 'eyedrop-face-at-point) (list "*point face name*"))
1706 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
1707 (push `,(concat "'" (symbol-name cand) "'") ipc))))
1710 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
1711 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
1712 (while (= (length face) 0)
1713 (setq face (icicle-transform-multi-completion
1714 (completing-read prompt (mapcar #'icicle-make-face-candidate (face-list))
1715 nil (not (stringp icicle-WYSIWYG-Completions-flag)) nil
1716 (if (boundp 'face-name-history)
1718 'icicle-face-name-history)))))
1719 (let ((proxy (car (member face icicle-proxy-candidates))))
1720 (cond ((save-match-data (string-match "*point face name\\*$" face))
1721 (eyedrop-face-at-point))
1722 (proxy (symbol-value (intern (substring proxy 1 (1- (length proxy))))))
1723 (t (intern face)))))))
1724 ((= emacs-major-version 21) ; Emacs 21
1725 (defun icicle-read-face-name (prompt)
1726 "Read a face name with completion and return its face symbol.
1727 PROMPT is the prompt.
1729 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
1730 also enter the name of a face-name variable - its value is returned.
1731 A face-name variable is a variable with custom-type `face'.
1733 If library `eyedropper.el' is used, then you can also choose proxy
1734 candidate `*point face name*' to use the face at point."
1735 (require 'eyedropper nil t)
1736 (let ((icicle-list-nth-parts-join-string ": ")
1737 (icicle-list-join-string ": ")
1738 ;; $$$$$$ (icicle-list-end-string "")
1739 (icicle-list-use-nth-parts '(1))
1740 (icicle-proxy-candidates
1741 (and icicle-add-proxy-candidates-flag
1742 (append (and (fboundp 'eyedrop-face-at-point) (list "*point face name*"))
1746 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
1747 (push `,(concat "'" (symbol-name cand) "'") ipc))))
1749 (face-list (face-list))
1750 (def (thing-at-point 'symbol))
1752 (cond ((assoc def face-list) (setq prompt (concat prompt " (default " def "): ")))
1754 prompt (concat prompt ": "))))
1755 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
1756 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
1757 (while (equal "" (setq face (icicle-transform-multi-completion
1759 prompt (mapcar #'icicle-make-face-candidate face-list) nil
1760 (not (stringp icicle-WYSIWYG-Completions-flag)) nil
1761 (if (boundp 'face-name-history)
1763 'icicle-face-name-history)
1765 (let ((proxy (car (member face icicle-proxy-candidates))))
1766 (cond ((save-match-data (string-match "*point face name\\*$" face))
1767 (eyedrop-face-at-point))
1768 (proxy (symbol-value (intern (substring proxy 1 (1- (length proxy))))))
1769 (t (intern face)))))))
1770 ((< emacs-major-version 24) ; Emacs 22-23
1771 (defun icicle-read-face-name (prompt &optional string-describing-default multiple)
1772 "Read a face name with completion and return its face symbol
1773 By default, use the face(s) on the character after point. If that
1774 character has the property `read-face-name', that overrides the `face'
1777 PROMPT should be a string that describes what the caller will do with the face;
1778 it should not end in a space.
1779 STRING-DESCRIBING-DEFAULT should describe what default the caller will use if
1780 the user just types RET; you can omit it.
1781 If MULTIPLE is non-nil, return a list of faces (possibly only one).
1782 Otherwise, return a single face.
1784 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
1785 also enter the name of a face-name variable - its value is returned.
1786 A face-name variable is a variable with custom-type `face'.
1788 If library `palette.el' or `eyedropper.el' is used, then you can also
1789 choose proxy candidate `*point face name*' to use the face at point."
1790 (or (require 'palette nil t) (require 'eyedropper nil t))
1791 (let ((faceprop (or (get-char-property (point) 'read-face-name)
1792 (get-char-property (point) 'face)))
1795 (icicle-proxy-candidates
1796 (and icicle-add-proxy-candidates-flag
1800 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
1801 (push `,(concat "'" (symbol-name cand) "'") ipc))))
1804 ;; Undo Emacs 22 brain-dead treatment of PROMPT arg.
1805 (when (save-match-data (string-match ": $" prompt))
1806 (setq prompt (substring prompt 0 -2)))
1807 ;; Try to get a face name from the buffer.
1808 (when (memq (intern-soft (thing-at-point 'symbol)) (face-list))
1809 (setq faces (list (intern-soft (thing-at-point 'symbol)))))
1810 ;; Add the named faces that the `face' property uses.
1811 (if (and (consp faceprop)
1812 ;; Don't treat an attribute spec as a list of faces.
1813 (not (keywordp (car faceprop)))
1814 (not (memq (car faceprop) '(foreground-color background-color))))
1815 (dolist (f faceprop) (when (symbolp f) (push f faces)))
1816 (when (and faceprop (symbolp faceprop)) (push faceprop faces)))
1819 ;; We leave this branch as it is. Icicles does nothing special with
1820 ;; `completing-read-multiple'.
1822 (mapatoms (lambda (s) (when (custom-facep s) ; Build up the completion tables.
1823 (if (get s 'face-alias)
1824 (push (symbol-name s) aliasfaces)
1825 (push (symbol-name s) nonaliasfaces)))))
1826 (let* ((input (completing-read-multiple ; Read the input.
1827 (if (or faces string-describing-default)
1828 (format "%s (default %s): "
1830 (mapconcat 'symbol-name faces ",")
1831 string-describing-default))
1832 (format "%s: " prompt))
1833 ;; This lambda expression is the expansion of Emacs 22 macro
1834 ;; (complete-in-turn nonaliasfaces aliasfaces). We expand it so
1835 ;; this can be compiled also in Emacs < 22 to work for Emacs 22.
1836 (lambda (string predicate mode)
1838 (or (all-completions string nonaliasfaces predicate)
1839 (all-completions string aliasfaces predicate)))
1841 (or (try-completion string nonaliasfaces predicate)
1842 (try-completion string aliasfaces predicate)))
1844 (or (test-completion string nonaliasfaces predicate)
1845 (test-completion string aliasfaces predicate)))))
1846 nil t nil (if (boundp 'face-name-history)
1848 'icicle-face-name-history)
1849 (and faces (mapconcat 'symbol-name faces ","))))
1850 (output (cond ((or (equal input "") (equal input '(""))) ; Canonicalize.
1853 (mapcar 'intern (split-string input ", *" t)))
1855 (mapcar 'intern input))
1857 output)) ; Return the list of faces
1859 (when (consp faces) (setq faces (list (car faces))))
1860 (let ((icicle-list-nth-parts-join-string ": ")
1861 (icicle-list-join-string ": ")
1862 ;; $$$$$$ (icicle-list-end-string "")
1863 (icicle-list-use-nth-parts '(1))
1864 (face-list (face-list))
1866 (mapconcat 'symbol-name faces ",")
1867 string-describing-default))
1869 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
1870 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
1871 (while (equal "" (setq face (icicle-transform-multi-completion
1874 (format "%s (default %s): " prompt def)
1875 (format "%s: " prompt))
1876 (mapcar #'icicle-make-face-candidate face-list)
1877 nil (not (stringp icicle-WYSIWYG-Completions-flag))
1878 nil (if (boundp 'face-name-history)
1880 'icicle-face-name-history)
1882 (let ((proxy (car (member face icicle-proxy-candidates))))
1884 (symbol-value (intern (substring proxy 1 (1- (length proxy)))))
1885 (intern face)))))))))
1887 (defun icicle-read-face-name (prompt &optional default multiple)
1888 "Read a face name with completion and return its face symbol.
1889 By default, use the face(s) on the character after point. If that
1890 character has the property `read-face-name', that overrides the `face'
1893 PROMPT should be a string that describes what the caller will do with the face;
1894 it should not end in a space.
1895 Optional arg DEFAULT provides the value to display in the minibuffer
1896 prompt. If not a string then it is also what is returned if the user
1897 just hits `RET' (empty input). If a string then `nil' is returned.
1899 If MULTIPLE is non-nil, return a list of faces (possibly only one).
1900 Otherwise, return a single face.
1902 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
1903 also enter the name of a face-name variable - its value is returned.
1904 A face-name variable is a variable with custom-type `face'.
1906 If library `palette.el' or `eyedropper.el' is used, then you can also
1907 choose proxy candidate `*point face name*' to use the face at point."
1908 (or (require 'palette nil t) (require 'eyedropper nil t))
1909 (let ((faceprop (or (get-char-property (point) 'read-face-name)
1910 (get-char-property (point) 'face)))
1913 (icicle-proxy-candidates
1914 (and icicle-add-proxy-candidates-flag
1918 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
1919 (push `,(concat "'" (symbol-name cand) "'") ipc))))
1922 ;; Undo vanilla Emacs brain-dead treatment of PROMPT arg.
1923 (when (save-match-data (string-match ": $" prompt))
1924 (setq prompt (substring prompt 0 -2)))
1925 ;; Try to get a face name from the buffer.
1926 (when (memq (intern-soft (thing-at-point 'symbol)) (face-list))
1927 (setq faces (list (intern-soft (thing-at-point 'symbol)))))
1928 ;; Add the named faces that the `face' property uses.
1929 (if (and (consp faceprop)
1930 ;; Don't treat an attribute spec as a list of faces.
1931 (not (keywordp (car faceprop)))
1932 (not (memq (car faceprop) '(foreground-color background-color))))
1933 (dolist (f faceprop) (when (symbolp f) (push f faces)))
1934 (when (and faceprop (symbolp faceprop)) (push faceprop faces)))
1937 ;; We leave this branch as it is. Icicles does nothing special with
1938 ;; `completing-read-multiple'.
1940 (mapatoms (lambda (s) (when (custom-facep s) ; Build up the completion tables.
1941 (if (get s 'face-alias)
1942 (push (symbol-name s) aliasfaces)
1943 (push (symbol-name s) nonaliasfaces)))))
1944 (let* ((input (completing-read-multiple ; Read the input.
1945 (if (or faces default)
1946 (format "%s (default `%s'): "
1948 (mapconcat 'symbol-name faces ",")
1950 (format "%s: " prompt))
1951 (completion-table-in-turn nonaliasfaces aliasfaces)
1952 nil t nil (if (boundp 'face-name-history)
1954 'icicle-face-name-history)
1955 (and faces (mapconcat 'symbol-name faces ","))))
1956 (output (cond ((or (equal input "") (equal input '(""))) ; Canonicalize.
1957 (or faces (and (not (stringp default)) default)))
1959 (mapcar 'intern (split-string input ", *" t)))
1961 (mapcar 'intern input))
1963 output)) ; Return the list of faces
1965 (when (consp faces) (setq faces (list (car faces))))
1966 (let ((icicle-list-nth-parts-join-string ": ")
1967 (icicle-list-join-string ": ")
1968 ;; $$$$$$ (icicle-list-end-string "")
1969 (icicle-list-use-nth-parts '(1))
1970 (face-list (face-list))
1972 (mapconcat 'symbol-name faces ",")
1973 (and (not (stringp default)) default)))
1975 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
1976 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
1977 (while (equal "" (setq face (icicle-transform-multi-completion
1980 (format "%s (default `%s'): " prompt def)
1981 (format "%s: " prompt))
1982 (mapcar #'icicle-make-face-candidate face-list)
1983 nil (not (stringp icicle-WYSIWYG-Completions-flag))
1984 nil (if (boundp 'face-name-history)
1986 'icicle-face-name-history)
1988 (let ((proxy (car (member face icicle-proxy-candidates))))
1990 (symbol-value (intern (substring proxy 1 (1- (length proxy)))))
1994 (defun icicle-make-face-candidate (face)
1995 "Return a completion candidate for FACE.
1996 The value of option `icicle-WYSIWYG-Completions-flag' determines the
1997 kind of candidate to use.
1998 If nil, then the face name is used (a string).
2000 If a string, then a multi-completion candidate is used, with the face
2001 name followed by a sample swatch using FACE on the string's text.
2003 If t, then the candidate is the face name itself, propertized with
2005 (if (stringp icicle-WYSIWYG-Completions-flag)
2006 (let ((swatch (copy-sequence icicle-WYSIWYG-Completions-flag)))
2007 (put-text-property 0 (length icicle-WYSIWYG-Completions-flag) 'face face swatch)
2008 (list (list (symbol-name face) swatch)))
2009 (let ((face-name (copy-sequence (symbol-name face))))
2010 (when icicle-WYSIWYG-Completions-flag
2011 (put-text-property 0 (length face-name) 'face face face-name))
2015 ;; REPLACE ORIGINAL `face-valid-attribute-values' in `faces.el',
2016 ;; saving it for restoration when you toggle `icicle-mode'.
2018 ;; Show color names in `*Completions*' with the (background) colors they name.
2019 ;; This is really so that commands such as `modify-face' take advantage of colored candidates.
2020 ;; We don't bother to try the same thing for Emacs 20, but the fix (directly to `modify-face') is
2021 ;; similar and trivial.
2023 (when (fboundp 'face-valid-attribute-values) ; Emacs 21+.
2024 (unless (fboundp 'old-face-valid-attribute-values)
2025 (defalias 'old-face-valid-attribute-values (symbol-function 'face-valid-attribute-values)))
2027 (if (fboundp 'window-system) ; Emacs 23+
2028 ;; Emacs 23+ `font-family-list' is strings, not conses of strings like older `x-font-family-list'.
2029 (defun icicle-face-valid-attribute-values (attribute &optional frame)
2030 "Return valid values for face attribute ATTRIBUTE.
2031 The optional argument FRAME is used to determine available fonts
2032 and colors. If it is nil or not specified, the selected frame is
2033 used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
2034 out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
2038 (:family (if (window-system frame)
2039 (mapcar (lambda (x) (cons x x)) ; Just strings, so don't take car.
2041 ;; Only one font on TTYs.
2042 (list (cons "default" "default"))))
2046 (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
2049 (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
2052 (mapcar #'(lambda (x) (cons (symbol-name (aref x 1)) (aref x 1)))
2055 (mapcar #'(lambda (x) (cons (symbol-name x) x))
2056 (internal-lisp-face-attribute-values attribute)))
2057 ((:underline :overline :strike-through :box)
2058 (if (window-system frame)
2059 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
2060 (internal-lisp-face-attribute-values attribute))
2061 (mapcar #'(lambda (c) (cons c c))
2062 (mapcar #'icicle-color-name-w-bg (defined-colors frame))))
2063 (mapcar #'(lambda (x) (cons (symbol-name x) x))
2064 (internal-lisp-face-attribute-values attribute))))
2065 ((:foreground :background)
2066 (mapcar #'(lambda (c) (cons c c))
2067 (mapcar #'icicle-color-name-w-bg (defined-colors frame))))
2068 ((:height) 'integerp)
2069 (:stipple (and (memq (window-system frame) '(x ns)) ; No stipple on w32
2070 (mapcar #'list (apply #'nconc (mapcar (lambda (dir)
2071 (and (file-readable-p dir)
2072 (file-directory-p dir)
2073 (directory-files dir)))
2074 x-bitmap-file-path)))))
2075 (:inherit (cons '("none" . nil)
2076 (mapcar #'(lambda (c) (cons (symbol-name c) c)) (face-list))))
2078 (error "Internal error")))))
2079 (if (and (listp valid) (not (memq attribute '(:inherit))))
2080 (nconc (list (cons "unspecified" 'unspecified)) valid)
2082 (defun icicle-face-valid-attribute-values (attribute &optional frame) ; Emacs 21-22.
2083 "Return valid values for face attribute ATTRIBUTE.
2084 The optional argument FRAME is used to determine available fonts
2085 and colors. If it is nil or not specified, the selected frame is
2086 used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
2087 out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
2091 (:family (if window-system
2092 (mapcar #'(lambda (x) (cons (car x) (car x)))
2093 (if (fboundp 'font-family-list)
2095 (x-font-family-list)))
2096 ;; Only one font on TTYs.
2097 (list (cons "default" "default"))))
2098 ((:width :weight :slant :inverse-video)
2099 (mapcar #'(lambda (x) (cons (symbol-name x) x))
2100 (internal-lisp-face-attribute-values attribute)))
2101 ((:underline :overline :strike-through :box)
2103 (nconc (mapcar #'(lambda (x) (cons (symbol-name x) x))
2104 (internal-lisp-face-attribute-values attribute))
2105 (mapcar #'(lambda (c) (cons c c))
2106 (mapcar #'icicle-color-name-w-bg (x-defined-colors frame))))
2107 (mapcar #'(lambda (x) (cons (symbol-name x) x))
2108 (internal-lisp-face-attribute-values attribute))))
2109 ((:foreground :background)
2110 (mapcar #'(lambda (c) (cons c c))
2111 (mapcar #'icicle-color-name-w-bg (x-defined-colors frame))))
2112 ((:height) 'integerp)
2113 (:stipple (and (memq window-system '(x w32 mac))
2114 (mapcar #'list (apply #'nconc (mapcar (lambda (dir)
2115 (and (file-readable-p dir)
2116 (file-directory-p dir)
2117 (directory-files dir)))
2118 x-bitmap-file-path)))))
2119 (:inherit (cons '("none" . nil)
2120 (mapcar #'(lambda (c) (cons (symbol-name c) c)) (face-list))))
2122 (error "Internal error")))))
2123 (if (and (listp valid) (not (memq attribute '(:inherit))))
2124 (nconc (list (cons "unspecified" 'unspecified)) valid)
2127 (defun icicle-color-name-w-bg (color-name)
2128 "Return copy of string COLOR-NAME with its background of that color.
2129 If `hexrgb.el' is not loaded, then just return COLOR-NAME."
2130 (if (featurep 'hexrgb)
2131 (let ((propertized-name (copy-sequence color-name)))
2132 (put-text-property 0 (length propertized-name)
2133 'face (cons 'background-color (hexrgb-color-name-to-hex color-name))
2139 ;; REPLACE ORIGINAL `completing-read-multiple' stuff in `crm.el',
2140 ;; saving it for restoration when you toggle `icicle-mode'.
2142 ;; Essentially, we just inhibit Icicles features for Icicle mode.
2144 (eval-after-load "crm"
2146 (when (fboundp 'crm-init-keymaps) (crm-init-keymaps)) ; Emacs 22, but not 23.
2147 ;; Save vanilla CRM stuff as `old-' stuff.
2148 (unless (fboundp 'old-completing-read-multiple)
2149 (defalias 'old-completing-read-multiple (symbol-function 'completing-read-multiple)))
2150 (defvar old-crm-local-completion-map crm-local-completion-map "Original CRM completion map.")
2151 (defvar old-crm-local-must-match-map crm-local-must-match-map "Original CRM must-match map.")
2153 ;; Define CRM stuff to use in Icicle mode. Basically, just inhibit Icicles features.
2154 (defun icicle-completing-read-multiple (prompt collection &optional predicate require-match
2155 initial-input hist def inherit-input-method)
2156 "Read multiple strings in the minibuffer, with completion.
2157 By using this functionality, a user may specify multiple strings at a
2158 single prompt, optionally using completion.
2160 Multiple strings are specified by separating each of the strings with
2161 a prespecified separator character. For example, if the separator
2162 character is a comma, the strings 'alice', 'bob', and 'eve' would be
2163 specified as 'alice,bob,eve'.
2165 The default value for the separator character is the value of
2166 `crm-default-separator' (comma). The separator character may be
2167 changed by modifying the value of `crm-separator'.
2169 Contiguous strings of non-separator-characters are referred to as
2170 'elements'. In the aforementioned example, the elements are: 'alice',
2173 Completion is available on a per-element basis. For example, if the
2174 contents of the minibuffer are 'alice,bob,eve' and point is between
2175 'l' and 'i', pressing TAB operates on the element 'alice'.
2177 The return value of this function is a list of the read strings.
2179 See the documentation for `completing-read' for details on the
2180 arguments: PROMPT, COLLECTION, PREDICATE, REQUIRE-MATCH,
2181 INITIAL-INPUT, HIST, DEF, and INHERIT-INPUT-METHOD."
2182 (let ((icicle-highlight-input-completion-failure nil))
2183 (old-completing-read-multiple prompt collection predicate require-match
2184 initial-input hist def inherit-input-method)))
2186 ;; Helper function - workaround because of a lack of multiple inheritance for keymaps.
2187 (defun icicle-define-crm-completion-map (map)
2188 "Make basic bindings for keymap MAP, a crm completion map."
2189 (set-keymap-parent map minibuffer-local-completion-map)
2190 (define-key map [remap minibuffer-complete] ; Emacs 22, 23.
2191 (if (fboundp 'crm-complete) #'crm-complete #'crm-minibuffer-complete))
2192 (when (fboundp 'crm-complete-word)
2193 (define-key map [remap minibuffer-complete-word] #'crm-complete-word))
2194 (when (and (boundp 'icicle-word-completion-keys) (fboundp 'crm-complete-word))
2195 (dolist (key icicle-word-completion-keys) (define-key map key #'crm-complete-word)))
2196 (define-key map [remap minibuffer-completion-help] ; Emacs 22, 23.
2197 (if (fboundp 'crm-completion-help) #'crm-completion-help #'crm-minibuffer-completion-help))
2198 (define-key map "?" #'crm-completion-help) ; Put back `?' as help (self-insert for Icicles).
2199 (when (boundp 'icicle-prefix-complete-keys) ; Don't use Icicles completion.
2200 (dolist (key icicle-prefix-complete-keys)
2201 (define-key map key ; Emacs 22, 23.
2202 (if (fboundp 'crm-complete) #'crm-complete #'crm-minibuffer-complete)))))
2204 (defvar icicle-crm-local-completion-map
2205 (let ((map (make-sparse-keymap)))
2206 (icicle-define-crm-completion-map map)
2208 "Local keymap for minibuffer multiple input with completion.
2209 Analog of `minibuffer-local-completion-map'.")
2211 (defvar icicle-crm-local-must-match-map
2212 (let ((map (make-sparse-keymap)))
2213 (icicle-define-crm-completion-map map)
2214 (define-key map [remap minibuffer-complete-and-exit]
2215 (if (fboundp 'crm-complete-and-exit)
2216 #'crm-complete-and-exit
2217 #'crm-minibuffer-complete-and-exit))
2219 "Local keymap for minibuffer multiple input with exact match completion.
2220 Analog of `minibuffer-local-must-match-map' for crm.")
2222 ;; Now, toggle Icicle mode, to take into account loading `crm.el' and redefining its stuff.
2223 (eval-after-load "icicles-mode" '(icicle-toggle-icicle-mode-twice))))
2226 ;; REPLACE ORIGINAL `read-shell-command' defined in `simple.el',
2227 ;; saving it for restoration when you toggle `icicle-mode'.
2228 ;; Uses Icicles completion.
2230 (defun icicle-read-shell-command (prompt &optional initial-contents hist default-value
2231 inherit-input-method)
2232 "Read a shell command.
2233 Use file-name completion, unless INITIAL-CONTENTS is non-nil.
2234 For completion, pass args to `icicle-read-shell-command-completing'."
2235 (if initial-contents
2236 (if (fboundp 'old-read-shell-command) ; Emacs 23+.
2237 (old-read-shell-command prompt initial-contents hist default-value inherit-input-method)
2238 (error "icicle-read-shell-command: YOU SHOULD NOT SEE THIS; use`M-x icicle-send-bug-report'"))
2239 (if (fboundp 'minibuffer-with-setup-hook)
2240 (minibuffer-with-setup-hook
2242 (set (make-local-variable 'minibuffer-default-add-function)
2243 'minibuffer-default-add-shell-commands))
2244 (icicle-read-shell-command-completing prompt initial-contents (or hist 'shell-command-history)
2245 default-value inherit-input-method))
2246 (icicle-read-shell-command-completing prompt initial-contents (or hist 'shell-command-history)
2247 default-value inherit-input-method))))
2250 ;; REPLACE ORIGINAL `shell-command' defined in `simple.el',
2251 ;; saving it for restoration when you toggle `icicle-mode'.
2252 ;; Uses Icicles completion.
2253 ;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
2255 (unless (fboundp 'read-shell-command) ; Emacs 23
2256 (defun icicle-dired-smart-shell-command (command &optional output-buffer error-buffer)
2257 "Like `icicle-shell-command', but in the current Virtual Dired directory.
2258 Uses Icicles completion - see `icicle-read-shell-command-completing'."
2260 (list (icicle-read-shell-command "Shell command: " nil nil
2261 (cond (buffer-file-name (file-relative-name buffer-file-name))
2262 ((eq major-mode 'dired-mode) (dired-get-filename t t))))
2264 shell-command-default-error-buffer))
2265 (let ((default-directory (if (fboundp 'dired-default-directory) ; Emacs 21+.
2266 (dired-default-directory)
2267 (default-directory))))
2268 (icicle-shell-command command output-buffer error-buffer))))
2271 ;; REPLACE ORIGINAL `shell-command' defined in `simple.el',
2272 ;; saving it for restoration when you toggle `icicle-mode'.
2273 ;; Uses Icicles completion.
2274 ;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
2276 (unless (fboundp 'read-shell-command) ; Emacs 23.
2277 (unless (fboundp 'old-shell-command)
2278 (defalias 'old-shell-command (symbol-function 'shell-command)))
2280 (defun icicle-shell-command (command &optional output-buffer error-buffer)
2281 "Execute string COMMAND in inferior shell; display output, if any.
2282 Uses Icicles completion - see `icicle-read-shell-command-completing'.
2284 With prefix argument, insert the COMMAND's output at point.
2286 If COMMAND ends in ampersand, execute it asynchronously.
2287 The output appears in the buffer `*Async Shell Command*'.
2288 That buffer is in shell mode.
2290 Otherwise, COMMAND is executed synchronously. The output appears in
2291 the buffer `*Shell Command Output*'. If the output is short enough to
2292 display in the echo area (which is determined by the variables
2293 `resize-mini-windows' and `max-mini-window-height'), it is shown
2294 there, but it is nonetheless available in buffer `*Shell Command
2295 Output*' even though that buffer is not automatically displayed.
2297 To specify a coding system for converting non-ASCII characters
2298 in the shell command output, use \\[universal-coding-system-argument] \
2299 before this command.
2301 Noninteractive callers can specify coding systems by binding
2302 `coding-system-for-read' and `coding-system-for-write'.
2304 The optional second argument OUTPUT-BUFFER, if non-nil,
2305 says to put the output in some other buffer.
2306 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
2307 If OUTPUT-BUFFER is not a buffer and not nil,
2308 insert output in current buffer. (This cannot be done asynchronously.)
2309 In either case, the output is inserted after point (leaving mark after it).
2311 If the command terminates without error, but generates output,
2312 and you did not specify \"insert it in the current buffer\",
2313 the output can be displayed in the echo area or in its buffer.
2314 If the output is short enough to display in the echo area
2315 \(determined by the variable `max-mini-window-height' if
2316 `resize-mini-windows' is non-nil), it is shown there.
2317 Otherwise,the buffer containing the output is displayed.
2319 If there is output and an error, and you did not specify \"insert it
2320 in the current buffer\", a message about the error goes at the end
2323 If there is no output, or if output is inserted in the current buffer,
2324 then `*Shell Command Output*' is deleted.
2326 If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
2327 or buffer name to which to direct the command's standard error output.
2328 If it is nil, error output is mingled with regular output.
2329 In an interactive call, the variable `shell-command-default-error-buffer'
2330 specifies the value of ERROR-BUFFER."
2332 (list (icicle-read-shell-command "Shell command: " nil nil
2333 (and buffer-file-name (file-relative-name buffer-file-name)))
2335 shell-command-default-error-buffer))
2336 (old-shell-command command output-buffer error-buffer)))
2339 ;; REPLACE ORIGINAL `shell-command-on-region' defined in `simple.el',
2340 ;; saving it for restoration when you toggle `icicle-mode'.
2341 ;; Uses Icicles completion.
2342 ;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
2344 (unless (fboundp 'read-shell-command) ; Emacs 23.
2345 (unless (fboundp 'old-shell-command-on-region)
2346 (defalias 'old-shell-command-on-region (symbol-function 'shell-command-on-region)))
2348 (defun icicle-shell-command-on-region (start end command &optional output-buffer replace
2349 error-buffer display-error-buffer)
2350 "Execute string COMMAND in inferior shell with region as input.
2351 Uses Icicles completion - see `icicle-read-shell-command-completing'.
2353 Normally, display any output in temp buffer `*Shell Command Output*';
2354 Prefix arg means replace the region with it. Return the exit code of
2357 To specify a coding system for converting non-ASCII characters
2358 in the input and output to the shell command, use \\[universal-coding-system-argument]
2359 before this command. By default, the input (from the current buffer)
2360 is encoded in the same coding system that will be used to save the file,
2361 `buffer-file-coding-system'. If the output is going to replace the region,
2362 then it is decoded from that same coding system.
2364 The noninteractive arguments are START, END, COMMAND,
2365 OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
2366 Noninteractive callers can specify coding systems by binding
2367 `coding-system-for-read' and `coding-system-for-write'.
2369 If the command generates output, the output may be displayed
2370 in the echo area or in a buffer.
2371 If the output is short enough to display in the echo area
2372 \(determined by the variable `max-mini-window-height' if
2373 `resize-mini-windows' is non-nil), it is shown there. Otherwise
2374 it is displayed in the buffer `*Shell Command Output*'. The output
2375 is available in that buffer in both cases.
2377 If there is output and an error, a message about the error
2378 appears at the end of the output.
2380 If there is no output, or if output is inserted in the current buffer,
2381 then `*Shell Command Output*' is deleted.
2383 If the optional fourth argument OUTPUT-BUFFER is non-nil,
2384 that says to put the output in some other buffer.
2385 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
2386 If OUTPUT-BUFFER is not a buffer and not nil,
2387 insert output in the current buffer.
2388 In either case, the output is inserted after point (leaving mark after it).
2390 If REPLACE, the optional fifth argument, is non-nil, that means insert
2391 the output in place of text from START to END, putting point and mark
2394 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
2395 or buffer name to which to direct the command's standard error output.
2396 If it is nil, error output is mingled with regular output.
2397 If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
2398 were any errors. (This is always t, interactively.) This argument is
2399 not available before Emacs 22.
2400 In an interactive call, the variable `shell-command-default-error-buffer'
2401 specifies the value of ERROR-BUFFER."
2402 (interactive (let (string)
2403 (unless (mark) (error "The mark is not set now, so there is no region"))
2404 ;; Do this before calling region-beginning and region-end, in case subprocess
2405 ;; output relocates them while we are in the minibuffer.
2406 (setq string (icicle-read-shell-command "Shell command on region: "))
2407 ;; call-interactively recognizes region-beginning and region-end specially,
2408 ;; leaving them in the history.
2409 (list (region-beginning) (region-end) string current-prefix-arg current-prefix-arg
2410 shell-command-default-error-buffer (= emacs-major-version 22))))
2411 (if (= emacs-major-version 22) ; `icicle-shell-command-on-region' not defined for Emacs 23+.
2412 (old-shell-command-on-region start end command output-buffer replace error-buffer
2413 display-error-buffer)
2414 (old-shell-command-on-region start end command output-buffer replace error-buffer))))
2416 (defvar icicle-files () "A files list")
2419 ;; REPLACE ORIGINAL `dired-read-shell-command' defined in `dired-aux.el'
2420 ;; and redefined in `dired-x.el', saving it for restoration when you toggle `icicle-mode'.
2421 ;; Uses Icicles completion.
2422 ;; Uses `icicle-minibuffer-default-add-dired-shell-commands', not
2423 ;; `minibuffer-default-add-dired-shell-commands'.
2424 ;; Binds `icicle-files' for use as free var elsewhere.
2426 (defun icicle-dired-read-shell-command (prompt arg files)
2427 "Read a shell command for FILES using file-name completion.
2428 Uses Icicles completion - see `icicle-read-shell-command-completing'.
2429 ARG is passed to `dired-mark-prompt' as its first arg, for the prompt.
2430 FILES are the files for which the shell command should be appropriate."
2431 (let ((icicle-files files))
2432 (if (fboundp 'minibuffer-with-setup-hook)
2433 (minibuffer-with-setup-hook
2435 (set (make-local-variable 'minibuffer-default-add-function)
2436 'icicle-minibuffer-default-add-dired-shell-commands))
2437 (dired-mark-pop-up nil 'shell files 'icicle-dired-guess-shell-command
2438 (format prompt (dired-mark-prompt arg files)) files))
2439 (dired-mark-pop-up nil 'shell files 'icicle-dired-guess-shell-command
2440 (format prompt (dired-mark-prompt arg files)) files))))
2442 (defun icicle-dired-guess-shell-command (prompt files)
2443 "Read a shell command for FILES using file-name completion.
2444 Call `icicle-read-shell-command-completing', passing PROMPT and FILES."
2445 (icicle-read-shell-command-completing prompt nil nil nil nil files))
2447 ;; Similar to `minibuffer-default-add-dired-shell-commands', but if Dired-X is available
2448 ;; we include also the commands from `dired-guess-default'.
2450 ;; Free var here: `icicle-files' is bound in `icicle-dired-read-shell-command'.
2452 (defun icicle-minibuffer-default-add-dired-shell-commands ()
2453 "Return a list of all commands associated with current dired files.
2454 The commands are from `minibuffer-default-add-dired-shell-commands',
2455 and if `dired-x.el' is used, `dired-guess-default'."
2457 (let ((dired-guess-cmds (and (boundp 'icicle-files) (fboundp 'dired-guess-default)
2458 (dired-guess-default icicle-files)))
2459 (mailcap-cmds (and (boundp 'icicle-files) (require 'mailcap nil t)
2460 (mailcap-file-default-commands icicle-files))))
2461 (when (stringp dired-guess-cmds) (setq dired-guess-cmds (list dired-guess-cmds)))
2462 (if (listp minibuffer-default)
2463 (append minibuffer-default dired-guess-cmds mailcap-cmds)
2464 (cons minibuffer-default (append dired-guess-cmds mailcap-cmds)))))
2466 (defun icicle-read-shell-command-completing (prompt &optional initial-contents hist default-value
2467 inherit-input-method files)
2468 "Read a shell command using file-name completion.
2469 FILES name some files for which the command might be appropriate.
2470 The other arguments are the same as those for `read-from-minibuffer',
2471 except that READ and KEYMAP are missing, and HIST defaults to
2472 `shell-command-history'.
2474 Completion is lax, so you can use any shell command you want, not
2475 just a completion candidate, and you can edit the completed input to
2476 add options and arguments etc.
2478 In addition to file-name candidates, the following are combined to
2479 produce extra completion candidates (which are indicated using face
2480 `icicle-extra-candidates' in buffer `*Completions*'):
2482 * If you use Dired X, then the rules defined by user option
2483 `dired-guess-shell-alist-user' and variable
2484 `dired-guess-shell-alist-default' provide candidates appropriate for
2485 the marked files in Dired.
2487 * Starting with Emacs 23, MIME-type associations provide candidates
2488 appropriate for the marked files.
2490 * If option `icicle-guess-commands-in-path' is non-nil, then
2491 executable files (or all files, if `shell-completion-execonly' is
2492 nil) in your search path provide candidates.
2494 In addition, if `icicle-extra-candidates' is non-nil, its elements are
2495 also included as extra candidates.
2497 Help is available for individual candidates, using `C-M-RET',
2498 `C-M-mouse-2', and so on. For an extra candidate (that is, for a
2499 shell command guessed to be appropriate), help is provided by the
2500 `apropos' shell command (if available). For a file name, help shows
2501 the file's properties."
2502 (let* ((dired-guess-files (and files (fboundp 'dired-guess-default)
2503 (dired-guess-default files)))
2504 (icicle-sort-comparer 'icicle-extra-candidates-first-p)
2505 (completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
2506 (insert-default-directory nil)
2507 (icicle-extra-candidates-dir-insert-p nil)
2508 (icicle-point-position-in-candidate 'input-end)
2509 (icicle-candidate-help-fn (lambda (cand)
2510 (if (member cand icicle-extra-candidates)
2512 (concat "apropos " (shell-quote-argument
2515 (icicle-describe-file cand))))
2516 (icicle-extra-candidates icicle-extra-candidates)
2517 (icicle-must-match-regexp icicle-file-match-regexp)
2518 (icicle-must-not-match-regexp icicle-file-no-match-regexp)
2519 (icicle-must-pass-after-match-predicate icicle-file-predicate)
2520 (icicle-transform-function 'icicle-remove-dups-if-extras)
2521 ;; (icicle-sort-comparer (or icicle-file-sort icicle-sort-comparer))
2522 (icicle-require-match-flag icicle-file-require-match-flag)
2523 (icicle-default-value ; Let user get default via `M-n', but don't insert it.
2524 (and (memq icicle-default-value '(t nil)) icicle-default-value)))
2525 (when (and dired-guess-files (atom dired-guess-files))
2526 (setq dired-guess-files (list dired-guess-files)))
2527 ;; Add dired-guess guesses and mailcap guesses to `icicle-extra-candidates'.
2528 (setq icicle-extra-candidates (append dired-guess-files
2529 (and files (require 'mailcap nil t) ; Emacs 23.
2530 (fboundp 'mailcap-file-default-commands)
2531 (mailcap-file-default-commands files))
2532 icicle-extra-candidates))
2533 (when icicle-guess-commands-in-path ; Add commands available from user's search path.
2534 (setq icicle-extra-candidates (append icicle-extra-candidates
2535 (or icicle-shell-command-candidates-cache
2536 (icicle-recompute-shell-command-candidates)))))
2537 (when icicle-extra-candidates
2538 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
2539 (put-text-property 0 1 'icicle-fancy-candidates t prompt))
2540 (let ((cmd (icicle-read-file-name prompt nil default-value nil initial-contents)))
2541 (when icicle-quote-shell-file-name-flag (setq cmd (icicle-quote-file-name-part-of-cmd cmd)))
2544 (defun icicle-quote-file-name-part-of-cmd (strg)
2545 "Double-quote the file name that starts string STRG, for the shell.
2546 This assumes a UNIX-style shell, for which the following characters
2547 normally need to be escaped in file names: [ \t\n;<>&|()'\"#$].
2548 This is appropriate, for example, if you use Cygwin with MS Windows.
2550 STRG is assumed to be a shell command, possibly including arguments
2551 and possibly ending with `&' to indicate asynchronous execution.
2553 The beginning of STRG is assumed to be a file name, possibly including
2554 the characters [ \t\n;<>&|()'\"#$]. This function double-quotes the
2555 file name only, not the rest of STRG.
2557 Example: If STRG is `c:/Program Files/My Dir/mycmd.exe arg1 arg2 &',
2558 and file c:/Program Files/My Dir/mycmd.exe exists, then this returns
2559 `\"c:/Program Files/My Dir/mycmd.exe\" arg1 arg2 &'."
2561 (if (not (string-match "[ \t\n;<>&|()'\"#$]" strg))
2568 (while (and indx ; Find longest prefix that matches a file name.
2569 (setq indx (1+ (length compl)))
2570 (<= indx (length strg))
2571 (setq prefix (substring strg 0 indx))
2572 (setq compl (try-completion prefix 'read-file-name-internal
2573 (if (> emacs-major-version 22)
2574 minibuffer-completion-predicate
2575 default-directory))))
2576 (when (and (<= (length compl) (length strg)) (string-match compl strg 0)
2577 (file-exists-p compl))
2578 (setq filename compl)))
2579 (if (or (string= "" filename) (not (file-exists-p filename)))
2581 (setq quoted-strg (concat "\"" filename "\""))
2582 (setq quoted-strg (concat quoted-strg (substring strg (length filename)))))))))
2585 ;; REPLACE ORIGINAL `recentf-make-menu-items' defined in `recentf.el',
2586 ;; saving it for restoration when you toggle `icicle-mode'.
2587 ;; Adds Icicles submenu to Open Recent menu.
2589 (defun icicle-recentf-make-menu-items (&optional menu)
2590 "Make menu items from the recent list.
2591 This is a menu filter function which ignores the MENU argument."
2592 (setq recentf-menu-filter-commands nil)
2593 (let* ((recentf-menu-shortcuts 0)
2594 (file-items (icicle-condition-case-no-debug err
2595 (mapcar 'recentf-make-menu-item
2596 (recentf-apply-menu-filter recentf-menu-filter
2597 (recentf-menu-elements
2598 recentf-max-menu-items)))
2599 (error (message "recentf update menu failed: %s" (error-message-string err))))))
2600 (append (or file-items '(["No files" t :help "No recent file to open" :active nil]))
2601 (if recentf-menu-open-all-flag
2602 '(["All..." recentf-open-files :help "Open recent files through a dialog" :active t])
2603 (and (< recentf-max-menu-items (length recentf-list)) ; `recentf-list' is free here.
2604 '(["More..." recentf-open-more-files
2605 :help "Open files not in the menu through a dialog" :active t])))
2606 (and recentf-menu-filter-commands '("---")) recentf-menu-filter-commands
2607 (and recentf-menu-items-for-commands '("---")) recentf-menu-items-for-commands
2610 ["+ Open Recent File..." icicle-recent-file]
2611 ["+ Open Recent File (Other Window)..." icicle-recent-file-other-window]
2612 ["+ Remove from Recent Files List..." icicle-remove-file-from-recentf-list]))))))
2614 ;;(@* "Icicles functions - completion display (not cycling)")
2616 ;;; Icicles functions - completion display (not cycling) -------------
2618 (defun icicle-display-candidates-in-Completions (&optional reverse-p no-display-p)
2619 "Refresh the current set of completion candidates in `*Completions*'.
2620 REVERSE-P non-nil means display the candidates in reverse order.
2621 NO-DISPLAY-P non-nil means do not display the candidates; just
2622 recompute them. If the value is `no-msg', then do not show a
2623 minibuffer message indicating that candidates were updated."
2624 ;;$$ ;; Pred is special if `minibuffer-completion-table' is a function.
2625 ;; (when (and (not (functionp minibuffer-completion-table))
2626 ;; (functionp minibuffer-completion-predicate))
2627 ;; (setq icicle-completion-candidates
2628 ;; (icicle-remove-if-not
2630 ;; (funcall minibuffer-completion-predicate
2631 ;; (if (arrayp minibuffer-completion-table) (intern cand) (list cand))))
2632 ;; icicle-completion-candidates)))
2634 ;; $$$ (case icicle-incremental-completion-flag
2635 ;; ((t always) (setq icicle-incremental-completion-p 'always))
2636 ;; ((nil) (setq icicle-incremental-completion-p nil)))
2638 ;; $$$$$ (unless (input-pending-p) ; Do nothing if user hit a key.
2640 ;; Upgrade `icicle-incremental-completion-p' if we are redisplaying, so that completions will
2641 ;; be updated by `icicle-call-then-update-Completions' when you edit.
2642 (setq icicle-incremental-completion-p icicle-incremental-completion-flag)
2643 (when (and (eq t icicle-incremental-completion-p) (get-buffer-window "*Completions*" 0))
2644 (setq icicle-incremental-completion-p 'always))
2645 (let ((nb-cands (length icicle-completion-candidates)))
2646 ;; $$$$$$ Could use this binding to prevent frame fitting, to allow room for images.
2647 ;; But that is not really the solution. Really should fit the frame or window in such a way
2648 ;; that it takes image sizes into account. Might need to wait for a fix to Emacs bug #7822.
2649 ;; (autofit-frames-flag (not icicle-image-files-in-Completions)))
2650 (cond ((eq no-display-p 'no-msg)) ; No-op.
2651 (no-display-p (icicle-msg-maybe-in-minibuffer
2652 (format "Candidates updated (%s matching): %d"
2653 icicle-current-completion-mode nb-cands)))
2654 ((null icicle-completion-candidates)
2655 (save-selected-window (icicle-remove-Completions-window))
2656 (icicle-msg-maybe-in-minibuffer
2657 (if (eq 'apropos icicle-current-completion-mode)
2658 (let ((typ (car (rassq icicle-apropos-complete-match-fn
2659 icicle-S-TAB-completion-methods-alist))))
2660 (concat "No " typ (and typ " ") "completions"))
2661 (case (icicle-current-TAB-method)
2662 (fuzzy "No fuzzy completions")
2663 (swank "No swank (fuzzy symbol) completions")
2664 (vanilla "No vanilla completions")
2665 (t "No prefix completions")))))
2667 (when (> nb-cands icicle-incremental-completion-threshold)
2668 (message "Displaying completion candidates..."))
2669 ;; Display `*Completions*' now, so we can get its window's width.
2670 ;; We don't wait for `with-output-to-temp-buffer' to display it, because displaying it
2671 ;; might lead to splitting the display window, which would change its width.
2672 ;; We need to know the width in order to calculate the proper candidate formatting.
2673 (when (consp icicle-completion-candidates)
2674 (let ((fit-frame-inhibit-fitting-flag t)
2675 (comp-buf (get-buffer-create "*Completions*")))
2676 (unless (get-buffer-window comp-buf 'visible)
2677 (save-selected-window (display-buffer comp-buf t 0)
2678 (deactivate-mark))))) ; Remove any leftover mouse selection.
2679 (with-output-to-temp-buffer "*Completions*"
2680 ;; Each candidate in `icicle-completion-candidates' is a string, regardless of the
2681 ;; original type of candidate used (e.g. symbol, string, alist candidate,...). Here,
2682 ;; provided `icicle-fancy-cands-internal-p' is non-nil, we transform these candidates,
2683 ;; replacing each by a string that takes into account symbol properties
2684 ;; `icicle-display-string' and `icicle-special-candidate'.
2686 ;; Because `icicle-completion-candidates' is affected, changes to the candidate strings
2687 ;; (e.g. propertizing) are also reflected in the completion return value chosen by the
2688 ;; user. It is not only the display in `*Completions*' that is affected.
2690 ;; The symbol whose properties are used is the one in the current obarray that is named
2691 ;; by the string candidate to be transformed. If there is no such symbol, then no
2692 ;; transformation occurs. Unless `minibuffer-completion-table' is an obarray, the
2693 ;; global obarray is used to get the symbol.
2695 ;; 1. If the symbol has an `icicle-display-string' property, then that property value
2696 ;; must be a string (possibly propertized). We replace the candidate by that string.
2698 ;; 2. If the symbol has an `icicle-special-candidate' property, then we transfer the
2699 ;; property to the candidate string as a set of text properties. (If the value is
2700 ;; not a plist, and `icicle-special-candidate-regexp' is nil, then just apply face
2701 ;; `icicle-special-candidate'.) The effect is similar to using
2702 ;; `icicle-special-candidate-regexp', but the completion return value is also
2704 (when icicle-fancy-cands-internal-p
2705 (setq icicle-completion-candidates
2706 (mapcar (lambda (cand)
2707 (let* ((symb (intern-soft
2708 cand (and (arrayp minibuffer-completion-table)
2709 minibuffer-completion-table)))
2710 (display-strg (and symb
2711 (stringp (get symb 'icicle-display-string))
2712 (get symb 'icicle-display-string)))
2713 (new-cand (or display-strg cand))
2714 (spec-prop (and symb (get symb 'icicle-special-candidate))))
2715 ;; Apply `icicle-special-candidate' property's value.
2716 ;; If the value is a plist, then apply the properties as text props.
2717 ;; Else (the value is t), apply face `icicle-special-candidate'.
2719 (setq new-cand (copy-sequence new-cand))
2720 (if (consp spec-prop)
2721 (add-text-properties 0 (length new-cand) spec-prop new-cand)
2722 (unless icicle-special-candidate-regexp
2723 (add-text-properties 0 (length new-cand)
2724 '(face icicle-special-candidate)
2727 icicle-completion-candidates)))
2728 ;; The `icicle-condition-case-no-debug' should not be needed, but it prevents an
2729 ;; "End of buffer" message from `display-completion-list' on Emacs 22.
2730 (icicle-condition-case-no-debug nil
2731 (display-completion-list
2732 (if reverse-p (reverse icicle-completion-candidates) icicle-completion-candidates))
2735 (save-window-excursion
2736 (with-current-buffer (get-buffer "*Completions*")
2737 (let ((buffer-read-only nil)
2739 (dir (and (icicle-file-name-input-p) icicle-last-input
2740 (icicle-file-name-directory icicle-last-input)))
2741 (hist (and (symbolp minibuffer-history-variable)
2742 (boundp minibuffer-history-variable)
2743 (symbol-value minibuffer-history-variable)))
2745 ;; Don't bother with buffer completion, `read-buffer-completion-ignore-case'.
2746 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
2747 (boundp 'read-file-name-completion-ignore-case))
2748 read-file-name-completion-ignore-case
2749 completion-ignore-case)))
2750 (goto-char (icicle-start-of-candidates-in-Completions))
2752 (let* ((beg (point))
2753 (end (next-single-property-change beg 'mouse-face nil eob))
2754 (next (next-single-property-change end 'mouse-face nil eob))
2757 ;; Highlight candidate specially if it is a proxy candidate.
2758 (let ((candidate (icicle-current-completion-in-Completions)))
2759 ;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
2760 (when (member candidate icicle-proxy-candidates)
2761 (setq faces (cons 'icicle-proxy-candidate faces))
2762 (if (not icicle-proxy-candidate-regexp)
2763 (add-text-properties beg end (cons 'face (list faces)))
2765 (when (string-match icicle-proxy-candidate-regexp candidate)
2766 (add-text-properties (+ beg (match-beginning 0)) (+ beg (match-end 0))
2767 (cons 'face (list faces))))))))
2769 ;; Highlight candidate specially if it is an extra candidate.
2770 (let ((candidate (icicle-current-completion-in-Completions)))
2771 ;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
2773 (when (member candidate icicle-extra-candidates)
2774 (setq faces (cons 'icicle-extra-candidate faces))
2775 (add-text-properties beg end (cons 'face (list faces))))))
2777 ;; Highlight candidate specially if it is a special candidate.
2778 (let ((candidate (icicle-current-completion-in-Completions)))
2779 ;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
2781 (when (and icicle-special-candidate-regexp
2782 (string-match icicle-special-candidate-regexp candidate))
2783 (setq faces (cons 'icicle-special-candidate faces))
2784 (if (not icicle-special-candidate-regexp)
2785 (add-text-properties beg end (cons 'face (list faces)))
2786 (add-text-properties (+ beg (match-beginning 0)) (+ beg (match-end 0))
2787 (cons 'face (list faces)))))))
2789 ;; Highlight candidate (`*-historical-candidate') if it was used previously.
2790 (when icicle-highlight-historical-candidates-flag
2791 (let ((candidate (icicle-current-completion-in-Completions)))
2792 (when dir (setq candidate (expand-file-name candidate dir)))
2793 (when (and (consp hist) (member candidate hist)
2794 (not (member candidate icicle-hist-cands-no-highlight)))
2795 (add-text-properties
2797 `(face ,(setq faces (cons 'icicle-historical-candidate faces)))))))
2799 ;; Highlight, inside the candidate, the expanded common match.
2800 (when (and (or icicle-expand-input-to-common-match-flag
2801 (eq icicle-current-completion-mode 'prefix))
2802 icicle-current-input (not (string= "" icicle-current-input)))
2805 (narrow-to-region beg end) ; Restrict to the completion candidate.
2806 (when (re-search-forward (regexp-quote (icicle-minibuf-input-sans-dir
2807 icicle-current-input))
2809 (setq faces (cons 'icicle-common-match-highlight-Completions faces))
2810 (put-text-property (match-beginning 0) (point) 'face faces)))))
2812 ;; Hide match for `icicle-current-input' (expanded common match, if available),
2813 ;; if `icicle-hide-common-match-in-Completions-flag' is non-nil.
2816 (narrow-to-region beg end) ; Restrict to the completion candidate.
2817 (when (and icicle-hide-common-match-in-Completions-flag
2818 icicle-common-match-string)
2819 (when (re-search-forward (regexp-quote icicle-common-match-string) nil t)
2820 (if (> emacs-major-version 20)
2821 (put-text-property (match-beginning 0) (point) 'display "...")
2822 (put-text-property (match-beginning 0) (point) 'invisible t))))))
2824 ;; Highlight, inside the candidate, what the input expression matches.
2825 (unless (and icicle-current-raw-input (string= "" icicle-current-raw-input)
2826 icicle-apropos-complete-match-fn)
2829 (narrow-to-region beg end) ; Restrict to the completion candidate.
2830 (let ((fn (if (and (eq 'prefix icicle-current-completion-mode)
2831 (not (memq (icicle-current-TAB-method)
2833 ;; $$$$$$ What is best for `vanilla' (Emacs 23) completion?
2835 (case icicle-apropos-complete-match-fn
2836 (icicle-scatter-match
2837 (lambda (input bound noerror)
2838 (re-search-forward (icicle-scatter input)
2840 (icicle-levenshtein-match
2841 (if (= icicle-levenshtein-distance 1)
2842 (lambda (input bound noerror)
2843 (re-search-forward (icicle-levenshtein-one-regexp
2846 're-search-forward))
2847 (otherwise 're-search-forward)))))
2849 (when (and (funcall fn (icicle-minibuf-input-sans-dir
2850 icicle-current-raw-input)
2852 (not (eq (match-beginning 0) (point))))
2853 (setq faces (cons 'icicle-match-highlight-Completions faces))
2854 (put-text-property (match-beginning 0) (point) 'face faces)))
2856 ;; If `icicle-hide-non-matching-lines-flag' then hide all lines
2857 ;; of candidate that do not match current input.
2858 (let ((candidate (icicle-current-completion-in-Completions))
2859 (input (icicle-minibuf-input-sans-dir
2860 icicle-current-raw-input))
2862 (when (and icicle-hide-non-matching-lines-flag
2863 (string-match "\n" candidate)
2864 (not (string= "\n" candidate)))
2867 (unless (funcall fn input (line-end-position) t)
2868 (if (> emacs-major-version 20)
2870 (line-beginning-position)
2871 (min (1+ (line-end-position)) (point-max))
2874 (line-beginning-position)
2875 (min (1+ (line-end-position)) (point-max))
2877 (forward-line 1))))))))
2879 ;; Highlight candidate if it has been saved.
2880 (when (and icicle-highlight-saved-candidates-flag
2881 icicle-saved-completion-candidates)
2882 (let ((candidate (icicle-current-completion-in-Completions)))
2883 (when (member candidate icicle-saved-completion-candidates)
2884 (let ((ov (make-overlay beg end)))
2885 (push ov icicle-saved-candidate-overlays)
2886 (overlay-put ov 'face 'icicle-saved-candidate)
2887 (overlay-put ov 'priority '10)))))
2889 ;; Treat `icicle-candidate-properties-alist'.
2890 ;; A `face' prop will unfortunately wipe out any `face' prop we just applied.
2891 (when icicle-candidate-properties-alist
2894 (narrow-to-region beg end) ; Restrict to the completion candidate.
2895 (let* ((candidate (buffer-substring (point-min) (point-max)))
2900 (join (concat "\\(" icicle-list-join-string "\\|$\\)"))
2901 (len-cand (length candidate))
2902 (len-join (length icicle-list-join-string))
2905 (while (and (or first (not (= end (match-beginning 0)))
2906 (< (+ end len-join) len-cand))
2907 (string-match join candidate
2908 (if (and (not first)
2909 (= end (match-beginning 0))
2915 end (or (match-beginning 0) len-cand))
2917 (assq partnum icicle-candidate-properties-alist))
2918 (properties (cadr entry))
2919 (propertize-join-string (car (cddr entry))))
2921 (add-text-properties
2922 (+ start orig-pt) (+ end orig-pt) properties))
2923 (when propertize-join-string
2924 (add-text-properties
2926 (+ end orig-pt len-join)
2928 (setq partnum (1+ partnum)
2929 start (match-end 0))))))))
2931 ;; Show thumbnail for an image file.
2932 (when (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
2933 (fboundp 'image-file-name-regexp)
2934 icicle-image-files-in-Completions
2935 (if (fboundp 'display-graphic-p) (display-graphic-p) window-system))
2936 (let ((image-file (icicle-transform-multi-completion
2937 (icicle-current-completion-in-Completions))))
2938 (when (and (require 'image-dired nil t)
2939 (if (fboundp 'string-match-p)
2940 (string-match-p (image-file-name-regexp) image-file)
2942 (string-match (image-file-name-regexp) image-file))))
2943 (let ((thumb-img (append (image-dired-get-thumbnail-image image-file)
2945 (img-ov (overlays-in (point) (1+ (point)))))
2947 (delete-overlay (car img-ov))
2948 (put-image thumb-img beg)
2949 (setq img-ov (loop for ov in (overlays-in (point) (1+ (point)))
2950 when (overlay-get ov 'put-image) collect ov into ovs
2951 finally return (car ovs)))
2952 (overlay-put img-ov 'image-file image-file)
2953 (overlay-put img-ov 'thumb-img thumb-img)
2954 (overlay-put img-ov 'image-size (image-size thumb-img))))
2955 ;; Replace file name with a space.
2956 (when (eq 'image-only icicle-image-files-in-Completions)
2957 (let ((name-ov (overlays-in end end)))
2959 (delete-overlay (car name-ov))
2960 (setq name-ov (make-overlay beg end))
2961 (overlay-put name-ov 'display " ")))))))
2963 ;; Remove all newlines for images-only display.
2964 (when (eq icicle-image-files-in-Completions 'image-only)
2965 (save-excursion (goto-char (icicle-start-of-candidates-in-Completions))
2966 (while (and (re-search-forward "$") (not (eobp)))
2968 (set-buffer-modified-p nil)
2969 (setq buffer-read-only t))))
2970 (with-current-buffer (get-buffer "*Completions*")
2971 (set (make-local-variable 'mode-line-frame-identification)
2974 (if (and icicle-max-candidates
2975 (< icicle-max-candidates icicle-nb-candidates-before-truncation))
2976 (format "shown / %d" icicle-nb-candidates-before-truncation)
2978 (put-text-property 0 (length mode-line-frame-identification)
2979 'face 'icicle-mode-line-help
2980 mode-line-frame-identification)
2981 (goto-char (icicle-start-of-candidates-in-Completions))
2982 (set-window-point (get-buffer-window "*Completions*" 0) (point))
2983 (icicle-fit-completions-window))
2984 (message nil))))) ; Clear out any "Looking for..."
2987 ;; REPLACE ORIGINAL `display-completion-list' (built-in function),
2988 ;; saving it for restoration when you toggle `icicle-mode'.
2990 ;; 1. Does not remove text properties from candidates when it displays them in `*Completions*'.
2991 ;; 2. Adjusts number of columns and their widths to window size.
2992 ;; 3. The optional second arg is ignored. In vanilla Emacs < 23, this is a string
2993 ;; representing a common prefix, and faces `completions-first-difference' and
2994 ;; `completions-common-part' are used on candidates.
2996 (unless (fboundp 'old-display-completion-list)
2997 (defalias 'old-display-completion-list (symbol-function 'display-completion-list)))
2999 (defun icicle-display-completion-list (completions &optional ignored)
3000 "Display the list of completions, COMPLETIONS, using `standard-output'.
3001 Each element may be just a symbol or string or may be a list of two
3002 strings to be printed as if concatenated.
3003 If it is a list of two strings, the first is the actual completion
3004 alternative, the second serves as annotation.
3005 `standard-output' must be a buffer.
3006 The actual completion alternatives, as inserted, are given the
3007 `mouse-face' property of `highlight'.
3008 At the end, this runs the normal hook `completion-setup-hook'.
3009 It can find the completion buffer in `standard-output'.
3010 The optional second arg is ignored."
3011 (if (not (bufferp standard-output))
3012 (let ((standard-output (current-buffer))) (icicle-display-completion-list completions))
3013 (let ((mainbuf (current-buffer))) ; $$$$$$ For Emacs 23 crap that puts base-size in last cdr.
3014 (with-current-buffer standard-output
3015 (goto-char (point-max))
3016 (when icicle-show-Completions-help-flag (icicle-insert-Completions-help-string))
3017 (let ((cand-intro-string (if completions
3018 "Possible completions are:\n"
3019 "There are no possible completions of what you have typed.")))
3020 (put-text-property 0 (length cand-intro-string) 'face 'icicle-Completions-instruction-1
3022 (insert cand-intro-string))
3023 ;; $$$$$$$$ Emacs 23 nonsense. Revisit this when Stefan finally removes that crud.
3024 ;; This is done in Emacs 23 `display-completion-list'.
3025 (when (and completions (fboundp 'completion-all-sorted-completions)) ; Emacs 23
3026 (let ((last (last completions)))
3027 ;; Set base-size from the tail of the list.
3028 (set (make-local-variable 'completion-base-size)
3029 (or (cdr last) (and (minibufferp mainbuf) 0)))
3030 (setcdr last nil))) ; Make completions a properly nil-terminated list.
3031 (icicle-insert-candidates completions)))
3032 ;; In vanilla Emacs < 23, the hook is run with `completion-common-substring' bound to
3033 ;; what is here called IGNORED.
3034 (run-hooks 'completion-setup-hook)
3037 (defun icicle-insert-candidates (candidates)
3038 "Insert completion candidates from list CANDIDATES into the current buffer."
3039 (when (consp candidates)
3040 (let* ((multilinep #'(lambda (cand)
3042 (or (string-match "\n" (car cand)) (string-match "\n" (cdr cand)))
3043 (string-match "\n" cand))))
3044 (any-multiline-p (loop for cand in candidates
3045 if (funcall multilinep cand) return t
3046 finally return nil))
3047 (max-cand-len (apply #'max (mapcar (lambda (cand)
3049 (+ (length (car cand)) (length (cadr cand)))
3052 (comp-win (get-buffer-window (current-buffer) 0))
3054 (let ((spcl-frame-params (special-display-p (buffer-name))))
3055 (cond ((and spcl-frame-params ; Special-buffer. Use its default frame width.
3056 (or (and (consp spcl-frame-params)
3057 (cdr (assq 'width (cadr spcl-frame-params))))
3058 (cdr (assq 'width special-display-frame-alist))
3059 (cdr (assq 'width default-frame-alist)))))
3060 (comp-win (1- (window-width comp-win))) ; Width picked by `display-buffer'.
3061 (t 40)))) ; Failsafe.
3062 (nb-cands (length candidates))
3063 (columns (if any-multiline-p
3065 (max 1 (min (/ (* 100 wwidth)
3066 (* icicle-candidate-width-factor max-cand-len))
3068 (colwidth (if (eq 1 columns) (min max-cand-len wwidth) (/ wwidth columns)))
3070 (rows (ceiling nb-cands columns))
3072 startpos endpos string)
3073 (dolist (cand candidates)
3074 (setq endpos (point))
3075 (cond ((eq icicle-completions-format 'vertical) ; Vertical layout.
3077 (forward-line (- rows))
3078 (setq column-nb (+ column-nb colwidth)
3080 (when (> column-nb 0)
3082 (let ((cand-end (point)))
3083 (indent-to column-nb icicle-inter-candidates-min-spaces)
3084 (put-text-property cand-end (point) 'mouse-face nil) ; Turn off `mouse-face', `face'
3085 (put-text-property cand-end (point) 'face nil))))
3086 (t ; Horizontal layout (`horizontal' or nil).
3088 (put-text-property (point) (point) 'mouse-face nil) ; Turn off `mouse-face'
3089 (indent-to (* (max 1 column-nb) colwidth) icicle-inter-candidates-min-spaces)
3090 (when (< wwidth (+ (max colwidth (if (consp cand)
3091 (+ (length (car cand)) (length (cadr cand)))
3094 (save-excursion ; This is like `fixup-whitespace', but only forward.
3095 (delete-region (point) (progn (skip-chars-forward " \t") (point)))
3096 (unless (or (looking-at "^\\|\\s)")
3097 (save-excursion (forward-char -1) (looking-at "$\\|\\s(\\|\\s'")))
3100 (setq column-nb columns))) ; End of the row. Simulate being in farthest column.
3101 (when (< endpos (point)) (set-text-properties endpos (point) nil))))
3102 ;; Convert candidate (but not annotation) to unibyte or to multibyte, if needed.
3103 (setq string (if (consp cand) (car cand) cand))
3104 (cond ((and (null enable-multibyte-characters) (multibyte-string-p string))
3105 (setq string (string-make-unibyte string)))
3106 ((and enable-multibyte-characters (not (multibyte-string-p string)))
3107 (setq string (string-make-multibyte string))))
3108 ;; Insert candidate (and annotation). Mouse-face candidate, except for any newline as final
3109 ;; char. This is so that candidates are visually separate in `*Completions*'. Instead,
3110 ;; however, put property `icicle-keep-newline' on any final \n in the candidate, so
3111 ;; `icicle-mouse-choose-completion' and `icicle-current-completion-in-Completions' can put
3112 ;; the newline back as part of the candidate.
3113 (cond ((atom cand) ; No annotation.
3114 (put-text-property (point) (progn (insert string)
3115 (if (and (eq ?\n (char-before (point)))
3116 (> (length string) 1)) ; Not just "\n".
3119 'mouse-face 'highlight)
3120 (when (eq ?\n (char-before (point)))
3121 (put-text-property (1- (point)) (point) 'icicle-keep-newline t)))
3122 (t ; Candidate plus annotation.
3123 (put-text-property (point) (progn (insert string)
3124 (if (and (eq ?\n (char-before (point)))
3125 (> (length string) 1)) ; Not just "\n".
3128 'mouse-face 'highlight)
3129 (when (eq ?\n (char-before (point)))
3130 (put-text-property (1- (point)) (point) 'icicle-keep-newline t))
3131 (set-text-properties (point) (progn (insert (cadr cand)) (point)) nil)))
3132 (if (not (eq icicle-completions-format 'vertical))
3133 (setq column-nb (mod (1+ column-nb) columns))
3134 (if (> column-nb 0) (forward-line) (insert "\n")) ; Vertical layout.
3135 (setq row (1+ row)))
3136 (when (and any-multiline-p (not (string-match "\n\'" cand)))
3137 (insert (if (eq 'vertical icicle-completions-format) "\n" "\n\n")))))))
3139 ;; ARG is not used yet/currently.
3140 (defun icicle-fit-completions-window (&optional arg)
3141 "Fit the window that is showing completions to its contents.
3142 Optional ARG determines what the effect is, as follows:
3144 nil - scale text size and fit window to contents
3145 fit-only - fit window to contents, but do not scale text size
3146 scale-only - scale text size but do not fit window to contents
3148 Text size scaling uses `icicle-Completions-text-scale-decrease' and is
3149 only available for Emacs 23+. (Do not scale in any case if using
3150 `oneonone.el' with a `*Completions*' frame.)."
3151 (unless (or (eq arg 'scale-only)
3152 (= emacs-major-version 23) ; `fit-window-to-buffer' is broken before 24: removes windows.
3153 (= emacs-major-version 22))
3154 (when (and (eq major-mode 'completion-list-mode) (fboundp 'fit-window-to-buffer))
3155 (let ((win (get-buffer-window "*Completions*" 0)))
3156 (unless (< (window-width win) (frame-width)) ; Don't shrink if split horizontally.
3157 (fit-window-to-buffer
3159 (or (and (symbolp icicle-last-top-level-command)
3160 (get icicle-last-top-level-command 'icicle-Completions-window-max-height))
3161 icicle-Completions-window-max-height))))))
3162 (unless (eq arg 'fit-only)
3163 (when (and (boundp 'icicle-Completions-text-scale-decrease) ; Emacs 23+
3164 (eq major-mode 'completion-list-mode)
3165 (or (not (boundp '1on1-*Completions*-frame-flag)) (not 1on1-*Completions*-frame-flag)))
3166 (text-scale-decrease icicle-Completions-text-scale-decrease))))
3168 (defun icicle-highlight-initial-whitespace (input)
3169 "Highlight any initial whitespace in your input.
3170 Only if `icicle-highlight-input-initial-whitespace-flag' is non-nil.
3171 INPUT is the current user input, that is, the completion root.
3172 This must be called in the minibuffer."
3173 (when (and icicle-highlight-input-initial-whitespace-flag (not (string= "" input)))
3174 (let ((case-fold-search
3175 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
3176 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
3177 (boundp 'read-file-name-completion-ignore-case))
3178 read-file-name-completion-ignore-case
3179 completion-ignore-case)))
3181 (goto-char (icicle-minibuffer-prompt-end))
3182 (when (and (icicle-file-name-input-p) insert-default-directory)
3183 (search-forward (icicle-file-name-directory-w-default input) nil t)) ; Skip directory.
3186 (narrow-to-region (point) (point-max)) ; Search within completion candidate.
3187 (while (and (not (eobp)) (looking-at "\\(\\s-\\|\n\\)+"))
3188 (put-text-property (point) (1+ (point)) 'face 'icicle-whitespace-highlight)
3190 ;; Remove any previous whitespace highlighting that is no longer part of prefix.
3192 (when (eq (get-text-property (point) 'face) 'icicle-whitespace-highlight)
3193 (put-text-property (point) (1+ (point)) 'face nil))
3194 (forward-char 1))))))))
3196 (defun icicle-minibuffer-prompt-end ()
3197 "Buffer position of end of minibuffer prompt, or `point-min'.
3198 Version of `minibuffer-prompt-end' that works for Emacs 20 and later."
3199 (if (fboundp 'minibuffer-prompt-end) (minibuffer-prompt-end) (point-min)))
3201 ;;(@* "Icicles functions - TAB completion cycling")
3203 ;;; Icicles functions - TAB completion cycling --------------------
3205 (defun icicle-prefix-candidates (input)
3206 "List of prefix or fuzzy completions for the current partial INPUT.
3207 INPUT is a string. Each candidate is a string."
3208 (setq icicle-candidate-nb nil)
3209 (if (or (and (eq 'fuzzy (icicle-current-TAB-method)) (featurep 'fuzzy-match))
3210 (and (eq 'swank (icicle-current-TAB-method)) (featurep 'el-swank-fuzzy)))
3212 (icicle-transform-candidates (append icicle-extra-candidates icicle-proxy-candidates
3213 (icicle-fuzzy-candidates input)))
3214 (quit (top-level))) ; Let `C-g' stop it.
3215 (let ((cands (icicle-unsorted-prefix-candidates input)))
3216 (cond (icicle-abs-file-candidates (icicle-strip-ignored-files-and-sort cands))
3217 (icicle-sort-comparer (icicle-maybe-sort-maybe-truncate cands))
3220 (defun icicle-fuzzy-candidates (input)
3221 "Return fuzzy matches for INPUT. Handles also swank fuzzy symbol match."
3223 (let ((candidates ()))
3224 ;; $$$$ Should treat other `minibuffer-completion-table' types also.
3225 (cond ((and (vectorp minibuffer-completion-table)
3226 (not (eq (icicle-current-TAB-method) 'swank)))
3227 (mapatoms (lambda (symb) (when (or (null minibuffer-completion-predicate)
3228 (funcall minibuffer-completion-predicate symb))
3229 (push (symbol-name symb) candidates)))
3230 minibuffer-completion-table)
3231 (setq candidates (FM-all-fuzzy-matches input candidates)))
3232 ((vectorp minibuffer-completion-table)
3233 (setq candidates (mapcar #'car
3234 (car (el-swank-fuzzy-completions
3235 input icicle-swank-timeout
3236 (or minibuffer-completion-predicate 'fboundp)
3237 icicle-swank-prefix-length)))))
3238 ((and (consp minibuffer-completion-table) (consp (car minibuffer-completion-table)))
3239 (dolist (cand minibuffer-completion-table)
3240 (when (or (null minibuffer-completion-predicate)
3241 (funcall minibuffer-completion-predicate cand))
3242 (push (car cand) candidates)))
3243 (setq candidates (FM-all-fuzzy-matches input candidates))))
3244 (let ((icicle-extra-candidates
3245 (icicle-remove-if-not
3246 (lambda (cand) (save-match-data (string-match input cand))) icicle-extra-candidates))
3247 (icicle-proxy-candidates
3248 (icicle-remove-if-not
3249 (lambda (cand) (save-match-data (string-match input cand))) icicle-proxy-candidates))
3250 (filtered-candidates
3251 (icicle-transform-candidates
3252 (append icicle-extra-candidates icicle-proxy-candidates
3253 (icicle-remove-if-not
3255 (let ((case-fold-search completion-ignore-case))
3256 (and (icicle-filter-wo-input cand)
3257 (or (not icicle-must-pass-after-match-predicate)
3258 (funcall icicle-must-pass-after-match-predicate cand)))))
3260 (when (consp filtered-candidates)
3261 (setq icicle-common-match-string (icicle-expanded-common-match input filtered-candidates)))
3262 (unless filtered-candidates (setq icicle-common-match-string nil))
3263 filtered-candidates))
3264 (quit (top-level)))) ; Let `C-g' stop it.
3266 (defun icicle-unsorted-prefix-candidates (input)
3267 "Unsorted list of prefix completions for the current partial INPUT.
3268 this also sets `icicle-common-match-string' to the expanded common
3269 prefix over all candidates."
3272 (if (icicle-not-basic-prefix-completion-p)
3273 (icicle-completion-all-completions input minibuffer-completion-table
3274 minibuffer-completion-predicate
3275 ;; $$$$$$ (- (point) (field-beginning)))
3277 (and (fboundp 'completion--field-metadata) ;Emacs24
3278 (completion--field-metadata
3279 (field-beginning))))
3280 (icicle-all-completions input minibuffer-completion-table
3281 minibuffer-completion-predicate
3282 icicle-ignore-space-prefix-flag)))
3283 (icicle-extra-candidates
3284 (icicle-remove-if-not
3287 (string-match (concat "^" (regexp-quote input)) cand))) icicle-extra-candidates))
3288 (icicle-proxy-candidates
3289 (icicle-remove-if-not
3292 (string-match (concat "^" (regexp-quote input)) cand))) icicle-proxy-candidates))
3293 (filtered-candidates
3294 (icicle-transform-candidates
3295 (append icicle-extra-candidates icicle-proxy-candidates
3296 (icicle-remove-if-not
3298 (let ((case-fold-search completion-ignore-case))
3299 (and (icicle-filter-wo-input cand)
3300 (or (not icicle-must-pass-after-match-predicate)
3301 (funcall icicle-must-pass-after-match-predicate cand)))))
3303 (when (consp filtered-candidates)
3304 (let ((common-prefix
3305 (if (icicle-not-basic-prefix-completion-p)
3306 (icicle-completion-try-completion input minibuffer-completion-table
3307 minibuffer-completion-predicate
3308 ;; $$$$$$ (- (point) (field-beginning)))
3310 (and (fboundp 'completion--field-metadata)
3311 (completion--field-metadata ; Emacs 24
3312 (field-beginning))))
3313 (try-completion input minibuffer-completion-table
3314 minibuffer-completion-predicate))))
3315 (setq icicle-common-match-string (if (eq t common-prefix) input common-prefix))))
3316 (unless filtered-candidates (setq icicle-common-match-string nil))
3317 filtered-candidates)
3318 (quit (top-level)))) ; Let `C-g' stop it.
3320 (defun icicle-file-name-prefix-candidates (input)
3321 "List of prefix completions for partial file name INPUT.
3323 Candidates can be directories. Each candidate is a string."
3324 (setq icicle-candidate-nb nil)
3325 ;; $$$$$$ (let ((default-directory (icicle-file-name-directory-w-default input)))
3326 ;; $$$$$$ (icicle-unsorted-file-name-prefix-candidates
3327 ;; $$$$$$ (or (icicle-file-name-nondirectory input) ""))))
3328 (icicle-strip-ignored-files-and-sort (icicle-unsorted-file-name-prefix-candidates input)))
3330 (defun icicle-unsorted-file-name-prefix-candidates (input)
3331 "Unsorted list of prefix completions for the current file-name INPUT.
3332 This also sets `icicle-common-match-string' to the expanded common
3333 prefix over all candidates."
3336 (if (icicle-not-basic-prefix-completion-p)
3337 (icicle-completion-all-completions input minibuffer-completion-table
3338 minibuffer-completion-predicate
3340 (and (fboundp 'completion--field-metadata) ;Emacs24
3341 (completion--field-metadata
3342 (field-beginning))))
3343 (icicle-all-completions input minibuffer-completion-table
3344 minibuffer-completion-predicate
3345 icicle-ignore-space-prefix-flag)))
3346 (icicle-extra-candidates
3347 (icicle-remove-if-not
3350 (string-match (concat "^" (regexp-quote input)) cand))) icicle-extra-candidates))
3351 (icicle-proxy-candidates
3352 (icicle-remove-if-not
3355 (string-match (concat "^" (regexp-quote input)) cand))) icicle-proxy-candidates))
3356 (filtered-candidates
3357 (icicle-transform-candidates
3358 (append icicle-extra-candidates icicle-proxy-candidates
3359 (icicle-remove-if-not
3361 (let ((case-fold-search
3362 (if (boundp 'read-file-name-completion-ignore-case)
3363 read-file-name-completion-ignore-case
3364 completion-ignore-case)))
3365 (if (member cand '("../" "./"))
3366 (member input '(".." ".")) ; Prevent "" from matching "../"
3368 ;;; $$$$$$ REMOVED - This was no good for PCM - e.g. input `ic-o' and candidates `icicles-opt.el[c]'.
3369 ;;; We don't do it for non-file-name completion, anyway, and it doesn't seem needed.
3370 ;;; (save-match-data
3371 ;;; (string-match (concat "^" (regexp-quote input)) cand))
3372 (icicle-filter-wo-input cand)
3373 (or (not icicle-must-pass-after-match-predicate)
3374 (funcall icicle-must-pass-after-match-predicate cand))))))
3376 (when (consp filtered-candidates)
3377 (let ((common-prefix
3378 (if (icicle-not-basic-prefix-completion-p)
3379 (icicle-completion-try-completion input minibuffer-completion-table
3380 minibuffer-completion-predicate
3382 (and (fboundp 'completion--field-metadata)
3383 (completion--field-metadata ; Emacs 24
3384 (field-beginning))))
3385 (try-completion input minibuffer-completion-table default-directory))))
3386 ;; If common prefix matches an empty directory, use that dir as the sole completion.
3387 (when (and (stringp common-prefix)
3388 (save-match-data (string-match "/\\.$" common-prefix))) ; Matches /., /..
3389 (setq common-prefix (substring common-prefix 0 (- (length common-prefix) 2))))
3390 (setq icicle-common-match-string (if (eq t common-prefix) input common-prefix))))
3391 (unless filtered-candidates (setq icicle-common-match-string nil))
3392 filtered-candidates)
3393 (quit (top-level)))) ; Let `C-g' stop it.
3395 ;;(@* "Icicles functions - S-TAB completion cycling")
3397 ;;; Icicles functions - S-TAB completion cycling -------------------
3399 (defun icicle-apropos-candidates (input)
3400 "List of candidate apropos completions for the current partial INPUT.
3401 INPUT is a string. Each candidate is a string."
3402 (setq icicle-candidate-nb nil)
3403 (let ((cands (icicle-unsorted-apropos-candidates input)))
3404 (cond (icicle-abs-file-candidates (icicle-strip-ignored-files-and-sort cands))
3405 (icicle-sort-comparer (icicle-maybe-sort-maybe-truncate cands))
3408 (defun icicle-unsorted-apropos-candidates (input)
3409 "Unsorted list of apropos completions for the current partial INPUT.
3410 When `icicle-expand-input-to-common-match-flag' is non-nil, this also
3411 sets `icicle-common-match-string' to the expanded common match of
3412 input over all candidates."
3415 (when icicle-regexp-quote-flag (setq input (regexp-quote input)))
3417 (if (and (functionp minibuffer-completion-table)
3418 (not icicle-apropos-complete-match-fn))
3419 ;; Let the function do it all.
3420 (icicle-all-completions input minibuffer-completion-table
3421 minibuffer-completion-predicate
3422 icicle-ignore-space-prefix-flag)
3423 (icicle-all-completions "" minibuffer-completion-table
3424 minibuffer-completion-predicate
3425 icicle-ignore-space-prefix-flag)))
3426 (icicle-extra-candidates
3427 (icicle-remove-if-not
3428 (lambda (cand) (save-match-data (string-match input cand))) icicle-extra-candidates))
3429 (icicle-proxy-candidates
3430 (icicle-remove-if-not
3431 (lambda (cand) (save-match-data (string-match input cand))) icicle-proxy-candidates))
3432 (filtered-candidates
3433 (icicle-transform-candidates
3434 (append icicle-extra-candidates icicle-proxy-candidates
3435 (icicle-remove-if-not
3437 (let ((case-fold-search completion-ignore-case))
3438 (and (icicle-filter-wo-input cand)
3439 (or (not icicle-apropos-complete-match-fn)
3440 ;; Assume no match if error - e.g. due to `string-match' with
3441 ;; binary data in Emacs 20. Do this everywhere we call
3442 ;; `icicle-apropos-complete-match-fn'.
3444 (funcall icicle-apropos-complete-match-fn input cand)
3446 (or (not icicle-must-pass-after-match-predicate)
3447 (funcall icicle-must-pass-after-match-predicate cand)))))
3449 (when (and icicle-expand-input-to-common-match-flag (consp filtered-candidates))
3450 (setq icicle-common-match-string (icicle-expanded-common-match input filtered-candidates)))
3451 (unless filtered-candidates (setq icicle-common-match-string nil))
3452 filtered-candidates)) ; Return candidates.
3453 (quit (top-level)))) ; Let `C-g' stop it.
3455 (defun icicle-file-name-apropos-candidates (input)
3456 "List of apropos completions for partial file-name INPUT.
3458 Candidates can be directories. Each candidate is a string."
3459 (setq icicle-candidate-nb nil)
3460 (let ((default-directory (icicle-file-name-directory-w-default input)))
3461 (icicle-strip-ignored-files-and-sort
3462 (icicle-unsorted-file-name-apropos-candidates (or (icicle-file-name-nondirectory input) "")))))
3464 (defun icicle-unsorted-file-name-apropos-candidates (input)
3465 "Unsorted list of apropos completions for the partial file-name INPUT.
3466 When `icicle-expand-input-to-common-match-flag' is non-nil, this also
3467 sets `icicle-common-match-string' to the expanded common match of
3468 input over all candidates."
3471 (when icicle-regexp-quote-flag (setq input (regexp-quote input)))
3473 ;; $$$$$ Should we remove string test for Emacs 23?
3474 (if (and (not (stringp minibuffer-completion-predicate))
3475 (not icicle-apropos-complete-match-fn)
3476 (functionp minibuffer-completion-table))
3477 ;; Let the function do it all.
3478 (icicle-all-completions input minibuffer-completion-table
3479 minibuffer-completion-predicate
3480 icicle-ignore-space-prefix-flag)
3481 (icicle-all-completions "" minibuffer-completion-table
3482 minibuffer-completion-predicate
3483 icicle-ignore-space-prefix-flag)))
3484 (icicle-extra-candidates
3485 (icicle-remove-if-not
3486 (lambda (cand) (save-match-data (string-match input cand)))
3487 icicle-extra-candidates))
3488 (icicle-proxy-candidates
3489 (icicle-remove-if-not
3490 (lambda (cand) (save-match-data (string-match input cand)))
3491 icicle-proxy-candidates))
3492 (filtered-candidates
3493 (icicle-transform-candidates
3494 (append icicle-extra-candidates icicle-proxy-candidates
3495 (icicle-remove-if-not
3497 (let ((case-fold-search
3498 (if (boundp 'read-file-name-completion-ignore-case)
3499 read-file-name-completion-ignore-case
3500 completion-ignore-case)))
3501 (if (member cand '("../" "./"))
3502 (member input '(".." ".")) ; Prevent "" from matching "../"
3503 (and (icicle-filter-wo-input cand)
3504 (or (not icicle-apropos-complete-match-fn)
3505 ;; Assume no match if error - e.g. due to `string-match'
3506 ;; with binary data in Emacs 20. Do this everywhere we
3507 ;; call `icicle-apropos-complete-match-fn'.
3509 (funcall icicle-apropos-complete-match-fn input cand)
3511 (or (not icicle-must-pass-after-match-predicate)
3512 (funcall icicle-must-pass-after-match-predicate cand))))))
3514 (when icicle-expand-input-to-common-match-flag
3515 (setq icicle-common-match-string (if (consp filtered-candidates)
3516 (icicle-expanded-common-match
3517 input filtered-candidates)
3519 (unless filtered-candidates (setq icicle-common-match-string nil))
3520 filtered-candidates)) ; Return candidates.
3521 (quit (top-level)))) ; Let `C-g' stop it.
3523 (defun icicle-expanded-common-match (input candidates)
3524 "Return the expanded common match for INPUT among all CANDIDATES.
3525 This assumes that INPUT matches each string in list CANDIDATES.
3526 Return nil if there is no common match.
3528 The expanded common match is typically, but not always, the longest
3529 common match. See the documentation, section `Expanded-Common-Match
3530 Completion', for details."
3531 ;; Since `icicle-expanded-common-match-1' checks only the first match for a single candidate,
3532 ;; we call it twice, once using the first candidate and once using the second.
3533 ;; Typically, one of these tries will give us the longest common match.
3535 (let ((first-try (icicle-expanded-common-match-1 input candidates))
3537 (when (and first-try (cadr candidates))
3538 (setq second-try (icicle-expanded-common-match-1
3539 input (cons (cadr candidates) (cons (car candidates) (cddr candidates))))))
3540 (if (> (length second-try) (length first-try)) second-try first-try))))
3542 (defun icicle-expanded-common-match-1 (input candidates)
3543 "Helper function for `icicle-expanded-common-match."
3544 ;; This does not always give a longest common match, because it looks only at the first match
3545 ;; of INPUT with the first candidate. What it returns is the longest match that is common to
3546 ;; all CANDIDATES and also contains the first match in the first candidate.
3547 (let ((case-fold-search
3548 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
3549 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
3550 (boundp 'read-file-name-completion-ignore-case))
3551 read-file-name-completion-ignore-case
3552 completion-ignore-case))
3553 (first (car candidates)))
3554 (and icicle-apropos-complete-match-fn ; Return nil if no match function.
3556 ;; Assume no common match in case of error - e.g. due to `string-match' with binary data
3557 ;; in Emacs 20. Do this throughout, whenever we call `icicle-apropos-complete-match-fn'.
3558 (unless (condition-case nil
3559 (funcall icicle-apropos-complete-match-fn input first)
3560 (error (throw 'ecm-error nil)))
3561 (error (throw 'ecm-error nil))) ; If input doesn't match candidate, return nil.
3562 (let* ((len-first (length first))
3565 (orig-match-beg (match-beginning 0))
3566 (orig-match-end (match-end 0))
3567 (ecm first) ; "ecm" for "expanded common match".
3568 (rest (cdr candidates))
3570 (if (= orig-match-beg end)
3571 (setq ecm "") ; INPUT was, for instance, "$" or "\\>$; return "".
3572 ;; Compare with the rest of the candidates, reducing as needed.
3573 (while (and rest ecm)
3575 (funcall icicle-apropos-complete-match-fn input (car rest))
3576 (error (throw 'ecm-error nil))) ; If input doesn't match candidate, return nil.
3577 (setq beg-next (match-beginning 0))
3578 ;; Remove any prefix that doesn't match some other candidate.
3579 (while (and (< beg orig-match-beg)
3580 (not (condition-case nil
3581 (funcall icicle-apropos-complete-match-fn
3582 (regexp-quote (substring ecm 0 (- orig-match-end beg)))
3584 (error (throw 'ecm-error nil))))
3585 (progn (setq beg-ecm (match-beginning 0)) (>= beg-ecm beg-next)))
3586 ;; Take a character off of the left.
3587 (setq ecm (substring ecm 1)
3589 ;; Remove any suffix that doesn't match some other candidate.
3590 (while (and (> end 0) (not (condition-case nil
3591 (funcall icicle-apropos-complete-match-fn
3592 (regexp-quote ecm) (car rest))
3593 (error (throw 'ecm-error nil)))))
3594 ;; Take a character off of the right.
3595 (setq ecm (substring ecm 0 (1- (length ecm)))
3597 (unless (and (condition-case nil
3598 (funcall icicle-apropos-complete-match-fn
3599 (regexp-quote ecm) (car rest))
3600 (error (throw 'ecm-error nil)))
3601 (condition-case nil ; Input must match the substring that is common.
3602 (funcall icicle-apropos-complete-match-fn input ecm)
3603 (error (throw 'ecm-error nil))))
3604 (setq ecm nil)) ; No possible expansion
3608 (defun icicle-scatter-match (string completion)
3609 "Returns non-nil if STRING scatter-matches COMPLETION.
3610 This means that all of the characters in STRING are also in string
3611 COMPLETION, in the same order, but perhaps scattered among other
3612 characters. For example, STRING = \"ure\" matches COMPLETION
3614 (string-match (icicle-scatter string) completion))
3616 (defun icicle-scatter (string)
3617 "Returns a regexp that matches a scattered version of STRING.
3618 The regexp will match any string that contains the characters in
3619 STRING, in the same order, but possibly with other characters as well.
3620 Returns, for example, \"a.*b.*c.*d\" for input string \"abcd\"."
3621 (if (> emacs-major-version 21)
3622 (mapconcat #'regexp-quote (split-string string "" t) ".*")
3623 (mapconcat #'regexp-quote (split-string string "") ".*")))
3625 (defun icicle-levenshtein-strict-match (s1 s2)
3626 "String S1 is within `icicle-levenshtein-distance' of string S2.
3627 This means that S1 differs by at most `icicle-levenshtein-distance'
3628 character deletions, insertions, or replacements from S2. The string
3629 lengths too must differ by at most `icicle-levenshtein-distance'.
3630 You probably want to turn off incremental completion (`C-#') if you
3631 use this match method; it is quite slow.
3632 To use this match method, you must also have library `levenshtein.el'."
3633 (and (require 'levenshtein nil t) (<= (levenshtein-distance s1 s2) icicle-levenshtein-distance)))
3635 (defun icicle-levenshtein-match (s1 s2)
3636 "String S1 is within `icicle-levenshtein-distance' of a substring of S2.
3637 S1 and S2 are strings. This means that S1 and some substring of S2
3638 differ by at most `icicle-levenshtein-distance' character deletions,
3639 insertions, or replacements.
3641 You will probably want to turn off incremental completion (`C-#') if
3642 you use this match method; it can be quite slow, especially with a
3643 large value of `icicle-levenshtein-distance'. To use this method with
3644 a value other than 1, you must also have library `levenshtein.el'."
3645 (if (= icicle-levenshtein-distance 1)
3646 (icicle-levenshtein-one-match s1 s2)
3647 (unless (require 'levenshtein nil t) (error "You need library `levenshtein.el' for this"))
3648 (catch 'icicle-levenshtein-match
3649 (dolist (sub (icicle-substrings-of-length s2 (length s1)))
3650 (when (<= (levenshtein-distance s1 sub) icicle-levenshtein-distance)
3651 (throw 'icicle-levenshtein-match t)))
3654 ;; This is much faster than testing with `levenshtein-distance' and a value of 1.
3655 (defun icicle-levenshtein-one-match (s1 s2)
3656 "S1 is within a Levenshtein distance of one of some substring of S2.
3657 That is, S1 with 0 or 1 char inserted, deleted or replaced is a
3658 substring of S2. S1 and S2 are strings.
3659 You do not need library `levenshtein.el' to use this function."
3660 (string-match (icicle-levenshtein-one-regexp s1) s2))
3662 (defun icicle-levenshtein-one-regexp (string)
3663 "Return a regexp for strings that are 1 Levenshtein unit from STRING."
3666 (dotimes (indx (length string))
3667 (setq regexp (concat regexp (substring string 0 indx) ".?" (substring string (1+ indx)) "\\|"
3668 (substring string 0 indx) "." (substring string indx) "\\|")))
3669 (setq regexp (concat (substring regexp 0 -1) ")"))))
3671 (defun icicle-substrings-of-length (string &optional len)
3672 "Return a list of substrings of STRING that have length LEN.
3673 If LEN is nil, treat it as the length of STRING."
3674 (unless len (setq len (length string)))
3678 (dotimes (idx (- (length string) (1- len))) (push (substring string idx (+ idx len)) subs))
3681 ;;(@* "Icicles functions - common helper functions")
3683 ;;; Icicles functions - common helper functions ----------------------
3685 ;; Main cycling function - used by `icicle-next-prefix-candidate', `icicle-next-apropos-candidate'.
3686 (defun icicle-next-candidate (nth candidates-fn &optional regexp-p)
3687 "Replace input by NTH next or previous completion for an input.
3688 Default value of NTH is 1, meaning use the next completion.
3689 Negative NTH means use a previous, not subsequent, completion.
3691 CANDIDATES-FN is a function that returns the list of candidate
3692 completions for its argument, the current partial input (a string).
3694 Optional arg REGEXP-P non-nil means that CANDIDATES-FN uses regexp
3695 matching. This is used to highlight the appropriate matching root.
3697 If option `icicle-help-in-mode-line-delay' is positive, then help on
3698 the current candidate is shown in the mode line."
3699 (let ((saved-last-input icicle-last-input)) ; For call to `icicle-recompute-candidates'.
3700 (unless (stringp icicle-last-completion-candidate)
3701 (setq icicle-last-completion-candidate icicle-initial-value))
3702 (setq nth (or nth 1)
3703 icicle-current-input (if (icicle-file-name-input-p)
3704 (abbreviate-file-name (icicle-input-from-minibuffer 'leave-envar))
3705 (icicle-input-from-minibuffer))
3707 (unless (and (symbolp this-command) (get this-command 'icicle-apropos-cycling-command)
3708 (or (and (symbolp last-command) (get last-command 'icicle-apropos-cycling-command))
3710 '(icicle-candidate-action
3711 icicle-remove-candidate icicle-mouse-remove-candidate
3712 icicle-apropos-complete icicle-apropos-complete-no-display))))
3713 (setq icicle-common-match-string nil)) ; Don't use old one, in `icicle-save-or-restore-input'.
3714 (icicle-save-or-restore-input)
3715 (when (and (icicle-file-name-input-p) (icicle-file-directory-p icicle-current-input))
3716 (setq icicle-default-directory icicle-current-input))
3717 (unless (eq this-command last-command)
3718 (icicle-recompute-candidates nth candidates-fn saved-last-input))
3719 (icicle-save-or-restore-input) ; Again, based on updated `icicle-common-match-string'.
3720 (cond ((null icicle-completion-candidates)
3721 (save-selected-window (icicle-remove-Completions-window))
3722 (minibuffer-message " [No completion]"))
3724 (icicle-clear-minibuffer)
3725 (let ((nb-cands (length icicle-completion-candidates))
3726 (unit (if (wholenump nth) 1 -1))
3728 ;; So `icomplete+' can append the number of other candidates to the minibuffer.
3729 (setq icicle-nb-of-other-cycle-candidates (1- nb-cands))
3730 (icicle-increment-cand-nb+signal-end nth nb-cands)
3731 (setq next (elt icicle-completion-candidates icicle-candidate-nb))
3732 (while (null next) ; Skip null candidates.
3733 (icicle-increment-cand-nb+signal-end unit nb-cands)
3734 (setq next (elt icicle-completion-candidates icicle-candidate-nb)))
3736 ;; Update last-candidate to NEXT. Need a copy, because we change its text properties.
3737 (setq icicle-last-completion-candidate (copy-sequence next))
3739 (icicle-insert-cand-in-minibuffer icicle-last-completion-candidate regexp-p)
3741 ;; Highlight current completion candidate, if `*Completions*' is displayed.
3742 (when (get-buffer-window "*Completions*" 0)
3744 ;; Refresh `*Completions*', updating it to reflect the current candidates.
3745 (unless (or (and (symbolp this-command)
3746 (get this-command 'icicle-apropos-cycling-command)
3747 (or (and (symbolp last-command)
3748 (get last-command 'icicle-apropos-cycling-command))
3749 (memq last-command '(icicle-candidate-action
3750 icicle-remove-candidate
3751 icicle-mouse-remove-candidate))))
3752 (and (symbolp this-command)
3753 (get this-command 'icicle-prefix-cycling-command)
3754 (or (and (symbolp last-command)
3755 (get last-command 'icicle-prefix-cycling-command))
3756 (memq last-command '(icicle-candidate-action
3757 icicle-remove-candidate
3758 icicle-mouse-remove-candidate)))))
3759 (icicle-display-candidates-in-Completions))
3760 (save-selected-window
3761 (select-window (get-buffer-window "*Completions*" 'visible))
3762 (if (fboundp 'thumfr-only-raise-frame) (thumfr-only-raise-frame) (raise-frame)))
3763 (icicle-highlight-candidate-in-Completions))
3764 (icicle-show-help-in-mode-line icicle-last-completion-candidate))))))
3766 (defun icicle-insert-cand-in-minibuffer (candidate regexp-p)
3767 "Insert CANDIDATE in minibuffer. Highlight root and initial whitespace.
3768 REGEXP-P non-nil means use regexp matching to highlight root."
3769 ;; Highlight any initial whitespace (probably a user typo).
3770 (icicle-highlight-initial-whitespace (if regexp-p icicle-current-raw-input icicle-current-input))
3772 ;; Underline the root that was completed, in the minibuffer.
3773 (let ((inp (icicle-minibuf-input-sans-dir icicle-current-input))
3775 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
3776 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
3777 (boundp 'read-file-name-completion-ignore-case))
3778 read-file-name-completion-ignore-case
3779 completion-ignore-case))
3781 (unless (and regexp-p (not icicle-regexp-quote-flag)) (setq inp (regexp-quote inp)))
3783 (setq indx (string-match inp icicle-last-completion-candidate))
3784 (when indx (put-text-property indx (match-end 0) 'face 'icicle-match-highlight-minibuffer
3785 icicle-last-completion-candidate))))
3787 (goto-char (icicle-minibuffer-prompt-end)) ; Need for Emacs 22+, or can get `Text read-only' error.
3788 ;; Insert candidate in minibuffer, and place cursor.
3789 (insert (if (and (icicle-file-name-input-p) insert-default-directory
3790 (or (not (member icicle-last-completion-candidate icicle-extra-candidates))
3791 icicle-extra-candidates-dir-insert-p))
3792 (icicle-dir-prefix-wo-wildcards icicle-current-input)
3795 (icicle-place-cursor icicle-current-input))
3797 (defun icicle-dir-prefix-wo-wildcards (filename)
3798 "Return the directory portion of FILENAME.
3799 If using partial completion, this is the portion before the first
3800 occurrence of `*'. Otherwise, this is just `file-name-directory'."
3801 (if (and (icicle-not-basic-prefix-completion-p) (boundp 'completion-styles)
3802 (member 'partial-completion completion-styles)
3803 (string-match "/[^/]*\\*" filename))
3804 (substring filename 0 (1+ (match-beginning 0)))
3805 (or (file-name-directory filename) ""))) ; Don't return nil, in any case.
3807 (defun icicle-show-help-in-mode-line (candidate)
3808 "If short help for CANDIDATE is available, show it in the mode-line.
3809 Do this only if `icicle-help-in-mode-line-delay' is positive."
3810 (when (> icicle-help-in-mode-line-delay 0)
3811 (let* ((cand (cond (;; Call to `lacarte-execute(-menu)-command' (in `lacarte.el').
3812 ;; Use command associated with menu item.
3813 (consp lacarte-menu-items-alist)
3814 (cdr (assoc candidate lacarte-menu-items-alist)))
3815 (;; Key-completion candidate. Get command from candidate.
3816 icicle-completing-keys-p
3817 (if (string= ".." candidate)
3819 (let ((cmd-name (save-match-data
3820 (string-match "\\(.+\\) = \\(.+\\)" candidate)
3821 (substring candidate (match-beginning 2)
3823 (if (string= "..." cmd-name) "Prefix key" (intern-soft cmd-name)))))
3824 (;; Buffer or file name.
3825 (or (get-buffer candidate)
3826 (icicle-file-name-input-p)
3827 icicle-abs-file-candidates)
3828 (icicle-transform-multi-completion candidate))
3829 (t ; Convert to symbol or nil.
3830 (intern-soft (icicle-transform-multi-completion candidate)))))
3831 (doc (progn (when (stringp candidate)
3832 (setq candidate (icicle-transform-multi-completion candidate)))
3833 (cond ((and (stringp candidate) ; String with help as property.
3834 (get-text-property 0 'icicle-mode-line-help candidate)))
3835 ((and cand (symbolp cand) ; Symbol.
3836 (cond ((get cand 'icicle-mode-line-help)) ; Help prop.
3837 ((fboundp cand) ; Function.
3838 (or (documentation cand t) ; Functon's doc string.
3839 (if (string-match ; Easy-menu item.
3840 "^menu-function-[0-9]+$" (symbol-name cand))
3841 (format "%s" (symbol-function cand))
3842 (format "Command `%s'" cand))))
3843 ((facep cand) (face-documentation cand)) ; Face.
3844 (t (documentation-property ; Variable.
3845 cand 'variable-documentation t)))))
3846 ((and (consp cand) (eq (car cand) 'lambda)) ; Lambda form.
3848 ((and (stringp cand) ; Prefix key, `..'.
3849 (member cand '("Prefix key" "GO UP")))
3851 ((stringp candidate) ; String without help property.
3852 (cond ((and (or (icicle-file-name-input-p) ; File name.
3853 icicle-abs-file-candidates)
3854 (file-exists-p candidate))
3855 (if (get-file-buffer candidate)
3856 (concat (icicle-help-line-buffer
3857 (get-file-buffer candidate) 'no-bytes-p) " "
3858 (icicle-help-line-file cand))
3859 (icicle-help-line-file candidate)))
3860 ((get-buffer candidate) ; Non-file buffer.
3861 (icicle-help-line-buffer candidate))
3862 (t nil)))))) ; Punt.
3863 (doc-line1 (and (stringp doc) (string-match ".+$" doc) (match-string 0 doc))))
3865 (put-text-property 0 (length doc-line1) 'face 'icicle-mode-line-help doc-line1)
3866 (icicle-show-in-mode-line
3868 (cond ((get-buffer-window "*Completions*" 'visible) "*Completions*")
3869 ((eq (current-buffer) (window-buffer (minibuffer-window))) (cadr (buffer-list)))
3870 (t (current-buffer))))))))
3872 (defun icicle-help-line-buffer (buffer &optional no-bytes-p)
3873 "Simple help string for BUFFER."
3874 (with-current-buffer buffer
3876 (format "Mode: %s" mode-name)
3877 (format "Bytes: %d, Mode: %s" (buffer-size) mode-name))))
3879 (defun icicle-help-line-file (file)
3880 "Simple help string for FILE."
3881 (let ((attrs (file-attributes file)))
3882 (and attrs (format "Bytes: %d, Saved: %s, Access: %s" (nth 7 attrs)
3883 (format-time-string "%c" (nth 5 attrs)) (nth 8 attrs))))) ; "%Y-%m-%d %H"
3885 (defun icicle-show-in-mode-line (text &optional buffer)
3886 "Display TEXT in BUFFER's mode line.
3887 The text is shown for `icicle-help-in-mode-line-delay' seconds, or
3888 until a user event. So call this last in a sequence of user-visible
3890 (message nil) ; Remove any msg, such as "Computing completion candidates...".
3891 (with-current-buffer (or buffer (current-buffer))
3892 (make-local-variable 'mode-line-format) ; Needed for Emacs 21+.
3893 (let ((mode-line-format text)) (force-mode-line-update) (sit-for icicle-help-in-mode-line-delay))
3894 (force-mode-line-update)))
3896 (defun icicle-recompute-candidates (nth candidates-fn saved-last-input)
3897 "Recompute `icicle-completion-candidates', if needed.
3898 If buffer `*Completions*' is already displayed, it is updated.
3899 This does nothing, unless the user changed the minibuffer input or the
3900 completion type has changed (from apropos to prefix or vice versa).
3901 NTH < 0 means candidate order is reversed in `*Completions*'.
3902 Argument CANDIDATES-FN is a function that recomputes the candidates.
3903 SAVED-LAST-INPUT is the last input, as in `icicle-last-input'."
3904 (unless (and icicle-last-completion-command
3905 (symbolp this-command) ; Need symbol for `get', below.
3906 (string= icicle-current-input saved-last-input) ; No change in user input.
3907 ;; No change in completion type: apropos vs prefix.
3908 (or (and (or (get icicle-last-completion-command 'icicle-apropos-completing-command)
3909 (memq icicle-last-completion-command
3910 '(icicle-candidate-set-complement icicle-mouse-remove-candidate
3911 icicle-keep-only-past-inputs)))
3912 (or (get this-command 'icicle-apropos-completing-command)
3913 (get this-command 'icicle-apropos-cycling-command)))
3914 (and (or (get icicle-last-completion-command 'icicle-prefix-completing-command)
3915 (memq icicle-last-completion-command
3916 '(icicle-candidate-set-complement icicle-mouse-remove-candidate
3917 icicle-keep-only-past-inputs)))
3918 (or (get this-command 'icicle-prefix-completing-command)
3919 (get this-command 'icicle-prefix-cycling-command)))))
3920 (when (string= icicle-current-input saved-last-input) ; Changed completion type, not user input.
3921 ;; Set `icicle-last-completion-command', to record new completion type.
3922 (cond ((and (symbolp this-command) (get this-command 'icicle-prefix-cycling-command))
3923 (setq icicle-last-completion-command
3924 (if (eq icicle-last-completion-command 'icicle-apropos-complete-no-display)
3925 'icicle-prefix-complete-no-display
3926 'icicle-prefix-complete)))
3927 ((and (symbolp this-command) (get this-command 'icicle-apropos-cycling-command))
3928 (setq icicle-last-completion-command
3929 (if (eq icicle-last-completion-command 'icicle-prefix-complete-no-display)
3930 'icicle-apropos-complete-no-display
3931 'icicle-apropos-complete)))))
3933 ;; Recompute and redisplay completion candidates. Reset candidate number.
3934 (setq icicle-completion-candidates
3936 (funcall candidates-fn icicle-current-input)
3937 (error icicle-completion-candidates))) ; No change if completion error.
3938 (when (get-buffer-window "*Completions*" 0) ; Update `*Completions*' display or remove it.
3939 (if icicle-completion-candidates
3940 (icicle-display-candidates-in-Completions (not (wholenump nth)))
3941 (save-selected-window (icicle-remove-Completions-window))))))
3943 (defun icicle-save-raw-input ()
3944 "Save `icicle-current-raw-input' as the latest previous input.
3945 It is saved to `icicle-previous-raw-file-name-inputs', if completing a
3946 file name, or `icicle-previous-raw-non-file-name-inputs', otherwise."
3947 (let* ((prev-inputs-var (if (icicle-file-name-input-p)
3948 'icicle-previous-raw-file-name-inputs
3949 'icicle-previous-raw-non-file-name-inputs))
3950 (prev-inputs (symbol-value prev-inputs-var)))
3951 (unless (string= "" icicle-current-raw-input)
3952 (set prev-inputs-var (icicle-put-at-head prev-inputs-var icicle-current-raw-input)))
3953 (when (> (length prev-inputs) icicle-completion-history-max-length)
3954 (setcdr (nthcdr (1- icicle-completion-history-max-length) prev-inputs) ()))))
3956 (defun icicle-save-or-restore-input ()
3957 "Save the current minibuffer input, or restore the last input.
3958 If there is a previous input and we are cycling, then restore the last
3959 input. (Cycled completions don't count as input.)
3960 Otherwise, save the current input for use by `C-l', and then compute
3961 the expanded common match.
3963 There are several particular cases that modulate the behavior - see
3966 ;; Restore last input, if there is some to restore and we are cycling.
3967 ((and icicle-last-input icicle-cycling-p icicle-last-completion-candidate)
3968 (setq icicle-current-input icicle-last-input)) ; Return `icicle-current-input'.
3971 ;; Save the current input for `C-l', then update it to the expanded common match.
3972 ;; Do NOT do this if:
3973 ;; the user doesn't want to use the expanded common match
3974 ;; or there is no common match string
3975 ;; or the last command was a cycling command
3976 ;; or the input and the completion mode have not changed
3977 ;; (so saved regexp will not be overwritten).
3978 ((not (or (and (not icicle-expand-input-to-common-match-flag)
3979 (eq icicle-current-completion-mode 'apropos))
3980 (not icicle-common-match-string)
3981 (and (symbolp last-command) (get last-command 'icicle-cycling-command)
3982 (not (get last-command 'icicle-completing-command))) ; Not `TAB' or `S-TAB'.
3983 (and (equal icicle-last-input icicle-current-input)
3984 (eq icicle-current-completion-mode
3985 (if (get icicle-last-completion-command 'icicle-prefix-completing-command)
3989 ;; Expand current input to expanded common match, after saving it for `C-l'.
3990 (let ((common (if (and (icicle-file-name-input-p) insert-default-directory)
3991 (if (string= "" icicle-common-match-string)
3992 (or (icicle-file-name-directory icicle-current-input) "")
3993 (directory-file-name (icicle-abbreviate-or-expand-file-name
3994 icicle-common-match-string
3995 (icicle-file-name-directory icicle-current-input))))
3996 icicle-common-match-string)))
3998 ;; Save current input for `C-l', then save common match as current input.
3999 ;; Do NOT do anything if we're ignoring letter case and that is the only difference
4000 ;; between the common match and the input (e.g. MS Windows file names).
4001 (unless (and case-fold-search
4002 (string= (icicle-upcase icicle-current-input) (icicle-upcase common))
4003 (not (string= icicle-current-input common)))
4005 ;; Save input for `C-l' if this is not `C-l' or `C-L'.
4006 ;; Save it also if this is the first cycling command, or the first after completion.
4007 (unless (or (memq this-command '(icicle-retrieve-previous-input
4008 icicle-retrieve-next-input))
4009 (and icicle-cycling-p
4010 (or icicle-candidate-nb ; Not the first cycling command.
4011 (and (symbolp last-command)
4012 (get last-command 'icicle-completing-command)))))
4013 (setq icicle-current-raw-input icicle-current-input)
4014 ;; Save it for `C-l', unless it is "". Drop old entries when too big.
4015 (icicle-save-raw-input))
4017 ;; Save expanded common match as current input, unless input is a directory.
4018 ;; Use `icicle-file-directory-p'.
4019 ;; `file-directory-p' fails to consider "~/foo//usr/" a directory.
4020 ;; $$$$$$ We could use the `icicle-file-directory-p' code with `icicle-file-name-directory'
4021 ;; instead of `icicle-file-name-directory-w-default', if that presents a problem.
4022 (unless (and (icicle-file-name-input-p) (icicle-file-directory-p icicle-current-input))
4023 (setq icicle-current-input common)))))
4025 ;; Save input for `C-l'.
4026 ;; Do NOT do this if:
4027 ;; this command is `C-l' or `C-L'
4028 ;; or we are cycling or the last command was a cycling command
4029 ;; or this command is the same as last command.
4030 ((not (or (memq this-command '(icicle-retrieve-previous-input icicle-retrieve-next-input))
4032 (and (symbolp last-command) (get last-command 'icicle-cycling-command)
4033 (not (get this-command 'icicle-completing-command)))
4034 ;;$$$ (and (symbolp last-command) (get last-command 'icicle-completing-command))
4035 (eq last-command this-command)))
4036 (setq icicle-current-raw-input icicle-current-input)
4037 ;; Save it for `C-l', unless it is "". Drop old entries when too big.
4038 (icicle-save-raw-input))
4039 ;; Forget last raw input, so it is not highlighted in `*Completions*'.
4040 ;; Do NOT do this if we are cycling.
4041 ((not icicle-cycling-p)
4042 (setq icicle-current-raw-input "")))))
4043 (setq icicle-last-input icicle-current-input)) ; Return `icicle-current-input'.
4045 (defun icicle-put-at-head (list-var element)
4046 "Put ELEMENT at the front of the value of LIST-VAR.
4047 If ELEMENT is already a member of the list, then it is moved to the
4048 front. Otherwise, it is added to the front. Membership is tested
4049 with `equal'. The return value is the new value of LIST-VAR.
4050 This is a destructive operation: the list structure is changed."
4051 (let* ((lis (symbol-value list-var))
4052 (tl (member element lis)))
4053 (cond ((null lis) (set list-var (list element)))
4054 ;;;((eq tl lis) (set list-var (cdr lis)))
4056 (when tl (setcdr (nthcdr (1- (- (length lis) (length tl))) lis) (cdr tl)))
4057 (set list-var (cons element lis)))))
4058 (symbol-value list-var))
4060 (defun icicle-remove-dots (filename)
4061 "Strip leading string through last ../ or ./ from FILENAME."
4062 (let ((newname filename))
4064 (while (or (string-match "\\.\\./" newname)
4065 (string-match "\\./" newname)
4066 ;; Emacs 21+ `file-relative-name' returns ".." and "." (no slash) for "" first arg
4067 (string-match "^\\.\\.$" newname)
4068 (string-match "^\\.$" newname))
4069 (setq newname (substring newname (match-end 0)))))
4072 (defun icicle-increment-cand-nb+signal-end (incr max)
4073 "Increment candidate number by INCR modulo MAX, and signal end of cycle."
4074 (setq icicle-candidate-nb (if icicle-candidate-nb
4075 (+ incr icicle-candidate-nb)
4076 (if (natnump incr) 0 (1- max))))
4077 (let ((wrapped (mod icicle-candidate-nb max)))
4078 (when (and (/= wrapped icicle-candidate-nb) (eq last-command this-command))
4079 (let ((visible-bell t)) (ding)))
4080 (setq icicle-candidate-nb wrapped)))
4082 (defun icicle-place-cursor (input &optional dont-activate-p)
4083 "Position point and mark with respect to the minibuffer candidate.
4084 Positions are `icicle-point-position-in-candidate' and
4085 `icicle-mark-position-in-candidate', respectively.
4086 INPUT is the current user input, that is, the completion root.
4087 Optional argument DONT-ACTIVATE-P means do not activate the mark."
4088 (let ((case-fold-search
4089 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
4090 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
4091 (boundp 'read-file-name-completion-ignore-case))
4092 read-file-name-completion-ignore-case
4093 completion-ignore-case))
4094 input-start-position)
4095 (goto-char (icicle-minibuffer-prompt-end))
4096 (setq input-start-position (point))
4097 (when (and (icicle-file-name-input-p) insert-default-directory)
4098 (search-forward (icicle-file-name-directory-w-default input) nil t)
4099 (setq input-start-position (point))) ; Skip directory.
4100 ;; Locate completion root within current completion candidate.
4101 (when (or (memq icicle-point-position-in-candidate '(root-start root-end))
4102 (memq icicle-mark-position-in-candidate '(root-start root-end)))
4105 (narrow-to-region (point) (point-max)) ; Search within the completion candidate.
4106 (condition-case lossage
4107 (re-search-forward (if icicle-regexp-quote-flag
4108 (regexp-quote (icicle-minibuf-input-sans-dir input))
4109 (icicle-minibuf-input-sans-dir input))
4111 (invalid-regexp (when (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
4113 (goto-char (point-max))))))))
4115 (case icicle-point-position-in-candidate
4116 (input-start (goto-char input-start-position))
4117 (input-end (goto-char (point-max)))
4118 (root-start (goto-char (max input-start-position (match-beginning 0))))
4119 (root-end (goto-char (max input-start-position (match-end 0)))))
4121 (unless (eq icicle-point-position-in-candidate icicle-mark-position-in-candidate)
4122 (push-mark (case icicle-mark-position-in-candidate
4123 (input-start input-start-position)
4124 (input-end (point-max))
4125 (root-start (max input-start-position (match-beginning 0)))
4126 (root-end (max input-start-position (match-end 0))))
4128 (not dont-activate-p)))))
4130 (defun icicle-highlight-candidate-in-Completions ()
4131 "Highlight the current candidate in `*Completions*'."
4132 (let ((compl-win (get-buffer-window "*Completions*" 0))
4135 (set-window-dedicated-p compl-win t)
4136 (save-window-excursion (select-window compl-win)
4137 (goto-char (icicle-start-of-candidates-in-Completions))
4138 (icicle-move-to-next-completion icicle-candidate-nb t)
4139 (set-buffer-modified-p nil)
4140 (setq curr-cand-pos (point)))
4141 (set-window-point compl-win curr-cand-pos))))
4143 (defun icicle-place-overlay (start end overlay face priority buffer &rest properties)
4144 "Put OVERLAY with FACE and PRIORITY between START and END in BUFFER.
4145 OVERLAY is a symbol whose value is the overlay. If nil, the overlay
4146 is created. If non-nil, it is simply moved.
4147 PROPERTIES are additional overlay properties to add: pairs of a
4148 property and a value."
4149 (if (symbol-value overlay) ; Overlay exists, just move it.
4150 (move-overlay (symbol-value overlay) start end buffer)
4151 (set overlay (make-overlay start end buffer))
4152 (overlay-put (symbol-value overlay) 'face face)
4153 (overlay-put (symbol-value overlay) 'priority priority)))
4155 (defun icicle-strip-ignored-files-and-sort (candidates)
4156 "Remove file names with ignored extensions, and \".\". Sort CANDIDATES.
4157 If `icicle-sort-comparer' is nil, then do not sort."
4158 (when (fboundp 'completion-ignored-build-apply) ; In `completion-ignored-build.el'.
4159 (let ((completion-ignored-extensions completion-ignored-extensions))
4160 (completion-ignored-build-apply)
4161 (icicle-update-ignored-extensions-regexp)))
4162 (let* ((pred1 (lambda (cand) (or (save-match-data
4163 (string-match icicle-ignored-extensions-regexp cand))
4164 (string= "./" cand))))
4165 (pred2 (lambda (cand) (string= "./" cand)))
4166 (new-candidates (icicle-remove-if (if icicle-ignored-extensions-regexp pred1 pred2)
4168 ;; If the only candidates have ignored extensions, then use them.
4169 (unless new-candidates (setq new-candidates (icicle-remove-if pred2 candidates)))
4170 (icicle-maybe-sort-maybe-truncate new-candidates)))
4172 (defun icicle-transform-candidates (candidates)
4173 "Apply `icicle-transform-function' to CANDIDATES.
4174 If `icicle-transform-function' is nil, return CANDIDATES.
4176 Note that this transformation is applied before completion candidates
4177 are made available to the user, in particular, before they are
4178 displayed in `*Completions*'. Its use is thus quite different from
4179 that of `icicle-transform-sole-candidate'."
4180 (if icicle-transform-function (funcall icicle-transform-function candidates) candidates))
4182 (defun icicle-transform-multi-completion (candidate)
4183 "Transform display CANDIDATE according to `icicle-list-use-nth-parts'.
4184 If CANDIDATE is not a multi-completion, return CANDIDATE unchanged.
4185 Return the possibly transformed candidate."
4186 (if (and icicle-list-use-nth-parts (not (equal "" candidate)))
4187 (let ((parts (split-string candidate icicle-list-join-string))) (icicle-join-nth-parts parts))
4190 (defun icicle-join-nth-parts (parts)
4191 "Join the elements in PARTS using `icicle-list-nth-parts-join-string'."
4192 (let* ((maxpart (length parts))
4193 (indexes icicle-list-use-nth-parts)
4198 (car parts) ; Nothing to join.
4200 (setq partnum (car indexes))
4201 (unless firstp (setq cand (concat cand icicle-list-nth-parts-join-string)))
4203 (unless (> partnum maxpart) (setq cand (concat cand (nth (1- partnum) parts))))
4204 (setq indexes (cdr indexes)))
4207 (defun icicle-display-cand-from-full-cand (cand)
4208 "Return the display candidate corresponding to full candidate CAND."
4209 (let ((parts (car cand)))
4211 parts ; Not a multi-completion.
4212 (if icicle-list-use-nth-parts
4213 (icicle-join-nth-parts parts) ; Join mult-completion parts per `icicle-list-use-nth-parts'.
4214 ;; Multi-completion, but no joining specified. Reconstitute the display candidate.
4215 ;; $$$$$$ (concat (mapconcat #'identity parts icicle-list-join-string)
4216 ;; icicle-list-end-string) ; $$$$$$
4217 (mapconcat #'identity parts icicle-list-join-string)))))
4219 (defun icicle-file-name-directory (file)
4220 "Like `file-name-directory', but backslash is not a directory separator.
4221 Do not treat backslash as a directory separator, even on MS Windows.
4222 Escape any backslashes, then call `file-name-directory' and return
4224 (let* ((escaped-file (subst-char-in-string ?\\ ?\a file))
4225 (dir (file-name-directory escaped-file)))
4226 (and dir (subst-char-in-string ?\a ?\\ dir))))
4228 (defun icicle-file-name-directory-w-default (file)
4229 "`icicle-file-name-directory', or `default-directory' if that is nil."
4230 (or (icicle-file-name-directory file) default-directory))
4232 (defun icicle-file-name-nondirectory (file)
4233 "Like `file-name-nondirectory', but does not treat backslash specially.
4234 That is, backslash is never treated as a directory separator."
4235 (let ((escaped-file (subst-char-in-string ?\\ ?\a file)))
4236 (subst-char-in-string ?\a ?\\ (file-name-nondirectory escaped-file))))
4239 ;; (defun icicle-file-name-input-p ()
4240 ;; "Return non-nil if expected input is a file name.
4241 ;; This is used, instead of variable `minibuffer-completing-file-name',
4242 ;; because we sometimes complete against an explicit alist of file names,
4243 ;; even in the overall context of file-name input. In that case, we do
4244 ;; not want to use file-name completion. An example of this is
4245 ;; completing against a history list of file names, using
4246 ;; `icicle-history'."
4247 ;; ;; Note that some Emacs 20 code uses this as the equivalent of
4248 ;; ;; `minibuffer-completing-file-name':
4249 ;; ;; (memq minibuffer-completion-table '(read-file-name-internal read-directory-name-internal))
4250 ;; (and (symbolp minibuffer-completion-table) (stringp minibuffer-completion-predicate)))
4252 (defun icicle-file-name-input-p ()
4253 "Return non-nil if reading a file name using `read-file-name'.
4254 This means that completion candidates are relative file names.
4255 If instead you want to test whether input is a file name, absolute or
4256 relative, use this test:
4258 (or (icicle-file-name-input-p) icicle-abs-file-candidates)"
4259 minibuffer-completing-file-name)
4261 (defun icicle-file-directory-p (file)
4262 "Local, faster replacement for `file-directory-p'.
4263 This does not do all of the file-handler processing that
4264 `file-directory-p' does, so it is not a general replacement."
4265 (and (stringp file) (string= file (icicle-file-name-directory-w-default file))))
4267 (defun icicle-minibuf-input ()
4268 "Return the user minibuffer input as a string, without text-properties."
4269 (save-selected-window (select-window (minibuffer-window)) (icicle-input-from-minibuffer)))
4271 ;;$$$ Do we need to double all $'s in output from `icicle-subst-envvar-in-file-name',
4272 ;; before calling `substitute-in-file-name'?
4273 (defun icicle-input-from-minibuffer (&optional leave-envvars-p)
4274 "Return the minibuffer input as a string, without text-properties.
4275 Unless optional arg LEAVE-ENVVARS-P is non-nil, substitute any
4276 environment vars by their values.
4277 The current buffer must be a minibuffer."
4278 (let ((input (if (fboundp 'minibuffer-contents)
4279 (minibuffer-contents) ; e.g. Emacs 22
4280 (buffer-substring (point-min) (point-max))))) ; e.g. Emacs 20
4281 ;; $$$$$$$$ (if (fboundp 'minibuffer-contents-no-properties)
4282 ;; (minibuffer-contents-no-properties) ; e.g. Emacs 22
4283 ;; (buffer-substring-no-properties (point-min) (point-max))))) ; e.g. Emacs 20
4284 (when (and (icicle-file-name-input-p)
4285 (not (string= "" input)) ; Do nothing if user deleted everything in minibuffer.
4286 (not leave-envvars-p))
4287 (let ((last-char ""))
4288 (when (eq ?\$ (aref input (1- (length input))))
4290 input (substring input 0 (1- (length input)))))
4293 (concat (subst-char-in-string ?\a ?\\
4295 (substitute-in-file-name
4296 (icicle-subst-envvar-in-file-name
4297 (subst-char-in-string ?\\ ?\a input 'in-place)))
4303 (defun icicle-minibuf-input-sans-dir (&optional input)
4304 "Return the user input, except for a directory portion if reading a file."
4305 (unless input (setq input (icicle-minibuf-input)))
4306 (if (icicle-file-name-input-p) (icicle-file-name-nondirectory input) input))
4308 (defun icicle-subst-envvar-in-file-name (input)
4309 "Substitute any environment vars in INPUT by their values.
4310 Unlike `substitute-in-file-name', this does not make any other
4311 changes, such as switching `\\' to `/' on MS Windows."
4312 (let ((pat1 "[^$]\\([$]{\\([^$}]+\\)}\\)") ; e.g. aaa${HOME}
4313 (pat2 "^[$]{\\([^$}]+\\)}") ; e.g. ${HOME}
4314 (pat3 "[^$]\\([$]\\([^$]+\\)\\)") ; e.g. aaa$HOME
4315 (pat4 "^[$]\\([^$]+\\)")) ; e.g. $HOME
4316 (cond ((string-match pat1 input)
4317 (replace-regexp-in-string pat1 (or (getenv (match-string 2 input))
4318 (concat "$" (match-string 2 input)))
4320 ((string-match pat2 input)
4321 (replace-regexp-in-string pat2 (or (getenv (match-string 1 input))
4322 (concat "$" (match-string 1 input)))
4324 ((string-match pat3 input)
4325 (replace-regexp-in-string pat3 (or (getenv (match-string 2 input))
4326 (concat "$" (match-string 2 input)))
4328 ((string-match pat4 input)
4329 (replace-regexp-in-string pat4 (or (getenv (match-string 1 input))
4330 (concat "$" (match-string 1 input)))
4334 ;; Provide for Emacs 20.
4336 (unless (fboundp 'replace-regexp-in-string)
4337 (defun replace-regexp-in-string (regexp rep string &optional
4338 fixedcase literal subexp start)
4339 "Replace all matches for REGEXP with REP in STRING.
4341 Return a new string containing the replacements.
4343 Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the
4344 arguments with the same names of function `replace-match'. If START
4345 is non-nil, start replacements at that index in STRING.
4347 REP is either a string used as the NEWTEXT arg of `replace-match' or a
4348 function. If it is a function it is applied to each match to generate
4349 the replacement passed to `replace-match'; the match-data at this
4350 point are such that match 0 is the function's argument.
4352 To replace only the first match (if any), make REGEXP match up to \\'
4353 and replace a sub-expression, e.g.
4354 (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1)
4358 ;; To avoid excessive consing from multiple matches in long strings,
4359 ;; don't just call `replace-match' continually. Walk down the
4360 ;; string looking for matches of REGEXP and building up a (reversed)
4361 ;; list MATCHES. This comprises segments of STRING which weren't
4362 ;; matched interspersed with replacements for segments that were.
4363 ;; [For a `large' number of replacements it's more efficient to
4364 ;; operate in a temporary buffer; we can't tell from the function's
4365 ;; args whether to choose the buffer-based implementation, though it
4366 ;; might be reasonable to do so for long enough STRING.]
4367 (let ((l (length string))
4368 (start (or start 0))
4371 (while (and (< start l) (string-match regexp string start))
4372 (setq mb (match-beginning 0)
4374 ;; If we matched the empty string, make sure we advance by one char
4375 (when (= me mb) (setq me (min l (1+ mb))))
4376 ;; Generate a replacement for the matched substring.
4377 ;; Operate only on the substring to minimize string consing.
4378 ;; Set up match data for the substring for replacement;
4379 ;; presumably this is likely to be faster than munging the
4380 ;; match data directly in Lisp.
4381 (string-match regexp (setq str (substring string mb me)))
4382 (setq matches (cons (replace-match (if (stringp rep)
4384 (funcall rep (match-string 0 str)))
4385 fixedcase literal str subexp)
4386 (cons (substring string start mb) matches))) ; unmatched prefix
4388 ;; Reconstruct a string from the pieces.
4389 (setq matches (cons (substring string start l) matches)) ; leftover
4390 (apply #'concat (nreverse matches))))))
4392 (defun icicle-filter-wo-input (candidate)
4393 "Filter completion (string) CANDIDATE using regexps and predicate.
4394 If CANDIDATE passes the filtering, return CANDIDATE. Else return nil.
4396 In addition to filtering out empty-string candidates, these variables
4397 are used for the filtering:
4398 `icicle-must-match-regexp'
4399 `icicle-must-not-match-regexp'
4400 `icicle-must-pass-predicate'
4402 This filtering is in addition to and prior to matching user input.
4403 Users do not see any candidates filtered out here.
4404 This filtering does not affect proxy candidates or extra candidates.
4406 See also variable `icicle-must-pass-after-match-predicate', which is
4407 similar to `icicle-must-pass-predicate' but is used after filtering
4408 using the user input."
4409 (and (not (string= "" candidate)) ; Filter out empty strings.
4410 (or (not icicle-must-match-regexp)
4411 (save-match-data (string-match icicle-must-match-regexp candidate)))
4412 (or (not icicle-must-not-match-regexp)
4413 (not (save-match-data (string-match icicle-must-not-match-regexp candidate))))
4414 (or (not icicle-must-pass-predicate) (funcall icicle-must-pass-predicate candidate))
4417 (defun icicle-complete-again-update (&optional no-display)
4418 "Complete again and update completions list.
4419 Update display too, if already shown and NO-DISPLAY is nil."
4420 (setq icicle-completion-candidates
4422 (funcall (case icicle-last-completion-command
4423 ((icicle-prefix-complete icicle-prefix-complete-no-display
4424 icicle-prefix-word-complete)
4425 (if (icicle-file-name-input-p)
4426 #'icicle-file-name-prefix-candidates
4427 #'icicle-prefix-candidates))
4429 (if (icicle-file-name-input-p)
4430 #'icicle-file-name-apropos-candidates
4431 #'icicle-apropos-candidates)))
4432 icicle-current-input)
4433 (error icicle-completion-candidates))) ; No change if completion error.
4434 (when (and (get-buffer-window "*Completions*" 0) (not no-display))
4435 (icicle-display-candidates-in-Completions)))
4437 (defun icicle-msg-maybe-in-minibuffer (format-string &rest args)
4438 "Display FORMAT-STRING as a message.
4439 If called with the minibuffer inactive, use `message'.
4441 If `icicle-minibuffer-message-ok-p', then use `minibuffer-message'.
4442 Else do nothing (no message display)."
4443 (if (active-minibuffer-window)
4444 (when icicle-minibuffer-message-ok-p
4445 (save-selected-window
4446 (select-window (minibuffer-window))
4447 (minibuffer-message (apply #'format (concat " [" format-string "]") args))))
4448 (apply #'message format-string args)))
4450 (defun icicle-delete-count (elt elts count)
4451 "Delete by side effect the first COUNT occurrences of ELT from list ELTS.
4452 This is like `delete', but it deletes only the first COUNT `equal'
4454 (while (and elts (equal elt (car elts)) (>= (setq count (1- count)) 0))
4455 (setq elts (cdr elts)))
4459 (while (and (cdr tail) (> nn 0))
4460 (when (equal elt (cadr tail))
4462 (setcdr tail (cddr tail)))
4463 (setq tail (cdr tail)))
4464 (when (and (equal elt (car tail)) (> count 0))
4465 (setq tail (cdr tail))))) ; Remove matching singleton.
4468 (defun icicle-position (item list)
4469 "Zero-based position of first occurrence of ITEM in LIST, else nil."
4471 (catch 'icicle-position
4473 (when (equal xx item) (throw 'icicle-position index))
4474 (setq index (1+ index)))
4477 (defun icicle-remove-if (pred xs)
4478 "A copy of list XS with no elements that satisfy predicate PRED."
4480 (dolist (x xs) (unless (funcall pred x) (push x result)))
4483 (defun icicle-remove-if-not (pred xs)
4484 "A copy of list XS with only elements that satisfy predicate PRED."
4486 (dolist (x xs) (when (funcall pred x) (push x result)))
4489 (defun icicle-frames-on (buffer &optional frame) ; From `frames-on' in `frame-fns.el'.
4490 "List of all live frames showing BUFFER (a buffer or its name).
4491 The optional FRAME argument is as for function `get-buffer-window'."
4492 (filtered-frame-list (function (lambda (fr) (get-buffer-window buffer fr)))))
4494 (defun icicle-candidate-set-1 (set-fn msg)
4495 "Helper function for defining Icicle set commands.
4496 SET-FN is the function to apply to the current and saved candidates.
4497 MESSAGE is the confirmation message to display in the minibuffer."
4498 (setq icicle-completion-candidates
4499 (funcall set-fn icicle-completion-candidates icicle-saved-completion-candidates))
4500 (if (null icicle-completion-candidates)
4501 (save-selected-window (select-window (minibuffer-window)) (minibuffer-message " [EMPTY SET]"))
4502 (icicle-maybe-sort-and-strip-candidates)
4503 (icicle-scroll-or-update-Completions msg)))
4505 (defun icicle-maybe-sort-and-strip-candidates ()
4506 "Sort `icicle-completion-candidates'. Strip ignored file names too."
4507 (if (or (icicle-file-name-input-p) icicle-abs-file-candidates) ; File names: relative or absolute.
4508 (setq icicle-completion-candidates
4509 (icicle-strip-ignored-files-and-sort icicle-completion-candidates))
4510 (setq icicle-completion-candidates (icicle-maybe-sort-maybe-truncate
4511 icicle-completion-candidates))))
4513 (defun icicle-scroll-or-update-Completions (msg)
4514 "Scroll `*Completions*' if this command was repeated; else update it."
4515 (if (get-buffer-window "*Completions*" 0)
4516 (if (eq last-command this-command)
4517 ;; User repeated the command. Scroll window around.
4518 (icicle-scroll-Completions-forward)
4519 ;; User did something else (e.g. changed input). Update the display.
4520 (icicle-display-candidates-in-Completions)
4521 (save-selected-window (select-window (minibuffer-window)) (minibuffer-message msg)))
4522 ;; No window yet. Show window.
4523 (icicle-display-candidates-in-Completions)
4524 (save-selected-window (select-window (minibuffer-window)) (minibuffer-message msg))))
4526 ;; $$ No longer used.
4527 (defun icicle-display-Completions ()
4528 "Display `*Completions*' buffer."
4529 (let ((completions (icicle-all-completions "" minibuffer-completion-table
4530 minibuffer-completion-predicate
4531 icicle-ignore-space-prefix-flag)))
4532 (when (> (length icicle-completion-candidates) icicle-incremental-completion-threshold)
4533 (message "Displaying completion candidates..."))
4534 (with-output-to-temp-buffer "*Completions*"
4535 (display-completion-list (icicle-maybe-sort-maybe-truncate completions)))))
4537 (defun icicle-maybe-sort-maybe-truncate (cands)
4538 "Return a copy of candidate list CANDS, maybe sorted, maybe truncated.
4539 Sort according to `icicle-sort-comparer'.
4540 Truncate according to `icicle-max-candidates'."
4541 (let ((new-cands cands))
4542 (when icicle-sort-comparer (setq new-cands (icicle-reversible-sort new-cands)))
4543 (when icicle-max-candidates
4544 (let ((lighter (cadr (assoc 'icicle-mode minor-mode-alist)))
4545 (regexp (concat (regexp-quote icicle-lighter-truncation) "$")))
4546 (cond ((and new-cands (< icicle-max-candidates ; Save total number before truncation
4547 (setq icicle-nb-candidates-before-truncation (length new-cands))))
4548 (unless (string-match regexp lighter)
4549 (icicle-clear-lighter 'not-truncated)
4551 'minor-mode-alist `(icicle-mode ,(concat lighter icicle-lighter-truncation)))))
4553 ;; Save total number before truncation in `icicle-nb-candidates-before-truncation'.
4554 (setq icicle-nb-candidates-before-truncation (length new-cands))
4555 (when (string-match regexp lighter)
4556 (icicle-clear-lighter 'truncated)
4560 ,(substring lighter 0
4561 (- (length lighter) (length icicle-lighter-truncation)))))))))
4562 (setq new-cands (icicle-take icicle-max-candidates new-cands)))
4565 (defun icicle-take (num xs)
4566 "Return a copy of list XS but with only the first NUM items.
4567 No error handling. NUM must be in the range 0 to (length XS)."
4568 ;; Recursive version would be just this:
4569 ;; (and xs (not (zerop num)) (cons (car xs) (icicle-take (1- num) (cdr xs)))))
4570 (and xs (not (zerop num))
4575 (when (> (setq count (1+ count)) num) (throw 'icicle-take new-xs))
4576 (setq new-xs (cons x new-xs)))
4579 ;; From `cl-seq.el', function `union', without keyword treatment.
4580 ;; Same as `simple-set-union' in `misc-fns.el'.
4581 (defun icicle-set-union (list1 list2)
4582 "Combine LIST1 and LIST2 using a set-union operation.
4583 The result list contains all items that appear in either LIST1 or
4584 LIST2. This is a non-destructive function; it copies the data if
4586 (cond ((null list1) list2)
4587 ((null list2) list1)
4588 ((equal list1 list2) list1)
4590 (unless (>= (length list1) (length list2))
4591 (setq list1 (prog1 list2 (setq list2 list1)))) ; Swap them.
4593 (unless (member (car list2) list1) (setq list1 (cons (car list2) list1)))
4594 (setq list2 (cdr list2)))
4597 ;; From `cl-seq.el', function `intersection', without keyword treatment.
4598 ;; Same as `simple-set-intersection' in `misc-fns.el'.
4599 (defun icicle-set-intersection (list1 list2)
4600 "Set intersection of lists LIST1 and LIST2.
4601 This is a non-destructive operation: it copies the data if necessary."
4603 (if (equal list1 list2)
4606 (unless (>= (length list1) (length list2))
4607 (setq list1 (prog1 list2 (setq list2 list1)))) ; Swap them.
4609 (when (member (car list2) list1) (setq result (cons (car list2) result)))
4610 (setq list2 (cdr list2)))
4613 ;; From `cl-seq.el', function `set-difference', without keyword treatment.
4614 ;; Same as `simple-set-difference' in `misc-fns.el'.
4615 (defun icicle-set-difference (list1 list2)
4616 "Combine LIST1 and LIST2 using a set-difference operation.
4617 The result list contains all items that appear in LIST1 but not LIST2.
4618 This is non-destructive; it makes a copy of the data if necessary, to
4619 avoid corrupting the original LIST1 and LIST2."
4620 (if (or (null list1) (null list2)) list1
4623 (unless (member (car list1) list2) (setq result (cons (car list1) result)))
4624 (setq list1 (cdr list1)))
4627 (defun icicle-get-candidates-from-saved-set (set-name &optional dont-expand-filesets-p)
4628 "Return the saved set of completion candidates named SET-NAME.
4629 SET-NAME can be the name of either an Icicles saved completion set or,
4630 if `icicle-filesets-as-saved-completion-sets-flag', an Emacs fileset.
4631 If optional arg DONT-EXPAND-FILESETS-P is non-nil, then don't expand
4632 fileset entries in a saved completion set. Instead, return them as
4634 (let ((cache-file (cdr (assoc set-name icicle-saved-completion-sets)))
4636 (cond ((and (not cache-file) ; Fileset - get explicit file list.
4637 icicle-filesets-as-saved-completion-sets-flag (featurep 'filesets) filesets-data
4638 (setq fst (filesets-get-fileset-from-name set-name)))
4639 (icicle-explicit-saved-completion-candidates (list fst)))
4640 ((not cache-file) (error "No such saved set: `%s'" set-name))
4641 ((not (icicle-file-readable-p cache-file)) (error "Cannot read cache file `%s'" cache-file))
4642 (t ; Icicles saved completion set.
4643 (let ((list-buf (find-file-noselect cache-file 'nowarn))
4646 (message "Retrieving saved candidates from `%s'..." cache-file)
4649 (when (listp (setq cands-read (read list-buf)))
4650 (message "Set `%s' read from file `%s'" set-name cache-file))
4651 (error (error "Could not read cache file. %s" (error-message-string err))))
4652 (icicle-kill-a-buffer list-buf))
4653 (unless cands-read (error "No completion candidates in file `%s'" cache-file))
4654 (dolist (cand (nreverse cands-read)) ; Convert saved to displayable candidates.
4655 (if (not (icicle-saved-fileset-p cand))
4656 (push (icicle-displayable-cand-from-saved-set cand) candidates)
4659 (error "Set `%s' includes a fileset, but cannot load `fileset.el'" set-name))
4661 (if dont-expand-filesets-p
4662 (push cand candidates)
4664 (append (mapcar #'icicle-displayable-cand-from-saved-set
4665 (icicle-get-candidates-from-saved-set (cadr cand)))
4669 (defun icicle-explicit-saved-completion-candidates (&optional saved-set)
4670 "Return the list of files represented by a saved completion set.
4671 Any fileset entries in the saved set are expanded to an explicit list
4673 Optional arg SAVED-SET is the Icicles saved completion set to use.
4674 It can be the set itself or its name.
4675 If SAVED-SET is nil, use `icicle-saved-completion-candidates'."
4676 (unless saved-set (setq saved-set icicle-saved-completion-candidates))
4677 (when (stringp saved-set) (setq saved-set (icicle-get-candidates-from-saved-set saved-set)))
4680 (dolist (entry saved-set)
4681 (cond ((atom entry) (push entry files))
4682 ((and (featurep 'filesets)
4683 (or (setq mode (filesets-entry-mode entry)) ; ("my-fs" (:files "a" "b"))
4684 (setq entry (cons "dummy" entry) ; (:files "a" "b")
4685 mode (filesets-entry-mode entry))))
4686 (message "Gathering file names...")
4687 (dolist (file (filesets-get-filelist entry mode)) (push file files)))
4688 (t (error "Bad `icicle-saved-completion-candidates' entry: `%S'" entry))))
4691 (defun icicle-saved-fileset-p (entry)
4692 "Return non-nil if ENTRY is a fileset entry in a saved completion set.
4693 ENTRY is a list whose car is `:fileset' - it is not a fileset name."
4694 (and (consp entry) (eq (car entry) ':fileset)))
4696 (defun icicle-displayable-cand-from-saved-set (cand)
4697 "Return display candidate for saved candidate CAND.
4698 If CAND is an atom, then return it as is."
4699 (let ((cand-w-mrkrs (icicle-readable-to-markers cand)))
4700 (if (atom cand-w-mrkrs)
4702 (let ((icicle-whole-candidate-as-text-prop-p t))
4703 (car (icicle-mctized-full-candidate cand-w-mrkrs))))))
4705 (defun icicle-readable-to-markers (cand)
4706 "Convert (deserialize) Lisp-readable representation CAND of candidate.
4707 A Lisp-readable candidate uses the following to represent a marker:
4708 (icicle-file-marker FILE-NAME MARKER-POSITION)
4709 or (icicle-marker BUFFER-NAME MARKER-POSITION)"
4710 (if (and (consp cand) (consp (cdr cand)) (consp (cddr cand)) (null (cdr (cddr cand)))
4711 (memq (car cand) '(icicle-file-marker icicle-marker)))
4712 (let ((file-or-buf (cadr cand))
4713 (pos (car (cddr cand)))
4715 (if (eq (car cand) 'icicle-file-marker)
4716 (let ((buf (find-file-noselect file-or-buf)))
4717 (unless buf (error "Cannot find file `%s'" file-or-buf))
4718 (setq file-or-buf buf))
4719 (unless (get-buffer file-or-buf) (error "You must first visit buffer `%s'" file-or-buf)))
4720 (set-marker (setq mrker (make-marker)) pos (get-buffer file-or-buf))
4723 (cons (icicle-readable-to-markers (car cand)) (icicle-readable-to-markers (cdr cand)))
4727 ;; REPLACE ORIGINAL `filesets-get-filelist' in `filesets.el'.
4728 ;; The original is bugged (I filed Emacs bug #976 on 2008-09-13).
4730 ;; * First get the tree from the ENTRY.
4731 ;; * Return all matching files under the directory, including in subdirs up to
4732 ;; `filesets-tree-max-level' for the entry.
4734 (eval-after-load 'filesets
4735 '(defun filesets-get-filelist (entry &optional mode event)
4736 "Get all files for fileset ENTRY.
4737 Assume MODE (see `filesets-entry-mode'), if provided."
4738 (let* ((mode (or mode (filesets-entry-mode entry)))
4740 ((:files) (filesets-entry-get-files entry))
4741 ((:file) (list (filesets-entry-get-file entry)))
4742 ((:ingroup) (let ((entry (expand-file-name
4745 (filesets-entry-get-master entry)))))
4746 (cons entry (filesets-ingroup-cache-get entry))))
4747 ((:tree) (let* ((dirpatt (filesets-entry-get-tree entry)) ; Added this line.
4748 (dir (nth 0 dirpatt)) ; Use DIRPATT, not ENTRY.
4749 (patt (nth 1 dirpatt)) ; Use DIRPATT, not ENTRY.
4750 (depth (or (filesets-entry-get-tree-max-level entry)
4751 filesets-tree-max-level)))
4752 (icicle-filesets-files-under 0 depth entry dir patt
4754 (icicle-file-name-input-p)))))
4755 ((:pattern) (let ((dirpatt (filesets-entry-get-pattern entry)))
4757 (let ((dir (filesets-entry-get-pattern--dir dirpatt))
4758 (patt (filesets-entry-get-pattern--pattern dirpatt)))
4759 ;;(filesets-message 3 "Filesets: scanning %s" dirpatt)
4760 (filesets-directory-files dir patt ':files t))
4761 ;; (message "Filesets: malformed entry: %s" entry)))))))
4762 (filesets-error 'error "Filesets: malformed entry: " entry)))))))
4763 (filesets-filter-list fl (lambda (file) (not (filesets-filetype-property file event)))))))
4765 (defun icicle-filesets-files-under (level depth entry dir patt &optional relativep)
4766 "Files under DIR that match PATT.
4767 LEVEL is the current level under DIR.
4768 DEPTH is the maximal tree scanning depth for ENTRY.
4771 PATT is a regexp that included file names must match.
4772 RELATIVEP non-nil means use relative file names."
4773 (and (or (= depth 0) (< level depth))
4774 (let* ((dir (file-name-as-directory dir))
4775 (files-here (filesets-directory-files dir patt nil (not relativep)
4776 (filesets-entry-get-filter-dirs-flag entry)))
4777 (subdirs (filesets-filter-dir-names files-here)) ; Subdirectories at this level.
4778 (files (filesets-filter-dir-names ; Remove directory names.
4781 (mapcar (lambda (subdir) ; Files below this level.
4782 (let* ((subdir (file-name-as-directory subdir))
4783 (full-subdir (concat dir subdir)))
4784 (icicle-filesets-files-under
4785 (+ level 1) depth entry full-subdir patt)))
4790 ;; Note that initial and trailing spaces will not be noticeable. That's OK.
4791 (defun icicle-highlight-complete-input ()
4792 "Highlight minibuffer input, showing that it is a sole completion.
4793 Overlay `icicle-complete-input-overlay' is created with `match' face,
4795 (let ((case-fold-search
4796 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
4797 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
4798 (boundp 'read-file-name-completion-ignore-case))
4799 read-file-name-completion-ignore-case
4800 completion-ignore-case))
4801 input-start-position)
4803 (goto-char (icicle-minibuffer-prompt-end))
4804 (setq input-start-position (point))
4805 (when (and (icicle-file-name-input-p) insert-default-directory)
4806 (search-forward (icicle-file-name-directory-w-default
4807 (icicle-input-from-minibuffer 'leave-envvars))
4809 (setq input-start-position (point))) ; Skip directory.
4810 (if icicle-complete-input-overlay ; Don't recreate if exists.
4811 (move-overlay icicle-complete-input-overlay
4812 input-start-position (point-max) (current-buffer))
4813 (setq icicle-complete-input-overlay (make-overlay input-start-position (point-max)))
4814 (overlay-put icicle-complete-input-overlay 'face 'icicle-complete-input)))))
4816 (defun icicle-call-then-update-Completions (fn &rest args)
4817 "Call FN with ARGS, then update `*Completions*' with input matches."
4820 ;;$$$ (let ((tramp-completion-mode t)) ; Fool Tramp into thinking it is in completion mode.
4821 (setq icicle-current-input (icicle-input-from-minibuffer)
4822 icicle-input-fail-pos nil)
4823 (setq icicle-last-input nil) ; $$$$$$$$ So icicle-save-or-restore-input => recompute candidates.
4824 (when (overlayp icicle-complete-input-overlay) (delete-overlay icicle-complete-input-overlay))
4825 (icicle-highlight-initial-whitespace icicle-current-input)
4826 (if (< (length icicle-current-input) icicle-Completions-display-min-input-chars)
4827 (save-selected-window (icicle-remove-Completions-window))
4828 ;; `icicle-highlight-input-noncompletion' return value saves call to `icicle-file-remote-p'.
4829 (let ((remote-test (icicle-highlight-input-noncompletion)))
4830 ;; If ALL of the following are true, then update `*Completions*' (complete again):
4831 ;; * incremental completion,
4832 ;; * `icicle-highlight-input-noncompletion' determined that it's a remote or local file
4833 ;; or we're not completing file names
4834 ;; or user said not to test for remote file names
4835 ;; or we check now and it's not a remote file,
4836 ;; * `*Completions*' is already displayed or `icicle-incremental-completion-p' is not t,
4837 ;; * there are not too many candidates or we have waited the full delay.
4838 (when (and icicle-incremental-completion-p
4839 (or (memq remote-test '(file-local-p file-remote-p))
4840 (not (icicle-file-name-input-p))
4841 (not icicle-test-for-remote-files-flag)
4842 ;; Might still be remote if `icicle-highlight-input-completion-failure'
4843 ;; is `always' or `explicit-remote' - cannot tell from `remote-test'.
4844 (and (not (eq remote-test 'file-local-p)) ; We don't know if it's local.
4845 (not (icicle-file-remote-p icicle-current-input))))
4846 (or (get-buffer-window "*Completions*" 0) ; Already displayed.
4847 ;; If value is, say, `always' or `display' then update anyway.
4848 (not (eq t icicle-incremental-completion-p)))
4849 (let ((len (length icicle-completion-candidates)))
4850 (or (and (> len 1) (> icicle-incremental-completion-threshold len)) ; Not many
4851 (sit-for icicle-incremental-completion-delay)))) ; Wait, unless input.
4852 (let ((icicle-edit-update-p t))
4853 (funcall (or icicle-last-completion-command
4854 (if (eq icicle-current-completion-mode 'prefix)
4855 #'icicle-prefix-complete
4856 #'icicle-apropos-complete)))
4857 (run-hooks 'icicle-update-input-hook)))))
4858 (setq mark-active nil)))
4860 (defun icicle-highlight-input-noncompletion ()
4861 "Highlight the portion of the current input that does not complete.
4862 See the doc strings of `icicle-highlight-input-completion-failure' and
4863 `icicle-test-for-remote-files-flag' for information about when this
4864 highlighting occurs.
4866 If we know the input is a remote file name, return `file-remote-p'.
4867 If we know it is a local file name, return `file-local-p'.
4868 If part of the input matches candidates, return that matching part.
4869 If no highlighting was attempted, return nil."
4870 (let ((input-start (icicle-minibuffer-prompt-end))
4871 (input (icicle-input-from-minibuffer))
4875 ((string= "" input) "") ; Return string: highlighting attempted.
4877 ;; One of these: pending input,
4878 ;; not highlighting,
4879 ;; highlighting `explicit-*' but not explicitly completing (TAB/S-TAB),
4880 ;; highlighting `implicit-*' but not incrementally completing,
4881 ;; highlighting `*-strict' but not strict completion (and testing remote files)
4882 ;; there are more candidates than the threshold for highlighting.
4883 ((or (input-pending-p)
4884 (not icicle-highlight-input-completion-failure)
4885 (and (not (get this-command 'icicle-completing-command))
4886 (memq icicle-highlight-input-completion-failure
4887 '(explicit explicit-strict explicit-remote)))
4888 (and (not icicle-incremental-completion-flag)
4889 (memq icicle-highlight-input-completion-failure '(implicit implicit-strict)))
4890 (and (not (icicle-require-match-p))
4891 icicle-test-for-remote-files-flag ; nil flag ignores strict setting for highlighting
4892 (memq icicle-highlight-input-completion-failure '(implicit-strict explicit-strict)))
4893 (let ((len (length icicle-completion-candidates)))
4894 (and (> len 1) (> len icicle-highlight-input-completion-failure-threshold))))
4895 nil) ; Return nil: no highlighting attempted.
4897 ;; Cursor is to the left of the last mismatch position.
4898 ((and icicle-input-fail-pos (< (point) icicle-input-fail-pos))
4899 (setq icicle-input-fail-pos nil) ; Reset failure position.
4900 ;; Remove vestigial highlighting on matched part (e.g. from another completion mode).
4901 (when (and (> (or icicle-input-fail-pos (point-max)) input-start)
4902 (overlayp icicle-input-completion-fail-overlay))
4903 (delete-overlay icicle-input-completion-fail-overlay))
4904 nil) ; Return nil: no highlighting attempted.
4906 ;; Remote file-name input, user didn't say to skip testing for remote files,
4907 ;; and highlighting is not `always' or `explicit-remote'.
4908 ((and (icicle-file-name-input-p)
4909 (not (memq icicle-highlight-input-completion-failure '(always explicit-remote)))
4910 icicle-test-for-remote-files-flag
4911 (let ((remotep (icicle-file-remote-p input)))
4912 (unless remotep (setq file-local-p 'file-local-p)) ; We know it's local, so save that.
4914 ;; Do the same as for the previous, except return indication that we know it is a remote file.
4915 (setq icicle-input-fail-pos nil)
4917 (when (and (> (or icicle-input-fail-pos (point-max)) input-start)
4918 (overlayp icicle-input-completion-fail-overlay))
4919 (delete-overlay icicle-input-completion-fail-overlay))
4920 'file-remote-p) ; Return `file-remote-p': we know it is a remote file.
4922 ((and icicle-highlight-input-completion-failure-delay
4923 (progn (message nil) ; Clear any message, e.g. "Computing completion candidates..."
4924 (sit-for icicle-highlight-input-completion-failure-delay)))
4925 ;; First, a quick check through last two chars.
4926 ;; If last succeeds, then done.
4927 ;; If last fails and next-to-last succeeds, then done.
4928 ;; Otherwise, highlight the others using a binary search.
4929 (let ((matchp (icicle-any-candidates-p input))) ; Entire input, through last char.
4931 ;; Record failure position and highlight last char.
4932 (setq icicle-input-fail-pos (if icicle-input-fail-pos
4933 (min icicle-input-fail-pos (point-max))
4936 (cond (icicle-input-completion-fail-overlay ; Don't recreate if exists.
4937 ;; Specify buffer in case overlay exists but is in a diff (e.g. recursive) minibuffer.
4938 (move-overlay icicle-input-completion-fail-overlay
4939 (1- icicle-input-fail-pos) (point-max)
4940 (window-buffer (active-minibuffer-window)))
4941 (overlay-put icicle-input-completion-fail-overlay
4942 'face (if (icicle-require-match-p)
4943 'icicle-input-completion-fail
4944 'icicle-input-completion-fail-lax)))
4946 (setq icicle-input-completion-fail-overlay (make-overlay (1- icicle-input-fail-pos)
4948 (overlay-put icicle-input-completion-fail-overlay
4949 'face (if (icicle-require-match-p)
4950 'icicle-input-completion-fail
4951 'icicle-input-completion-fail-lax))))
4952 ;; See if next-to-last char gives a match. Typical use case: mistyping a char at end.
4953 (setq input (substring input 0 (1- (length input))))
4954 (unless (string= "" input)
4955 (setq matchp (icicle-any-candidates-p input))
4956 ;; If more than just the last char fails, highlight the others using binary search.
4957 (unless matchp (icicle-highlight-input-noncompletion-rest)))))
4958 ;; Highlighting attempted, so return non-nil. If we know it's local, return `file-local-p'.
4959 ;; If we don't know that, return the part of INPUT that matches.
4960 (or file-local-p input))
4961 (t nil)))) ; Return nil: no highlighting attempted.
4963 (defun icicle-highlight-input-noncompletion-rest ()
4964 "Helper function for `icicle-highlight-input-noncompletion'."
4965 (let* ((input-start (icicle-minibuffer-prompt-end))
4966 (pos (1- icicle-input-fail-pos))
4968 (last-pos input-start)
4971 (while (and (> pos input-start) (or (not matchp) (< pos icicle-input-fail-pos))) ; Binary search.
4972 (setq input (buffer-substring input-start pos)
4973 delta (max 1 (/ (abs (- pos last-pos)) 2))
4974 matchp (icicle-any-candidates-p input))
4975 ;; $$$$$$ Emacs BUG (prefix completion): c:/foo/$$ does not highlight the `$$', because
4976 ;; (try-completion "c:/foo/$" 'read-file-name-internal "c:/foo/") returns "c:/foo/$".
4977 ;; (However, c:/foo/$ highlights the `$' correctly.)
4978 (unless matchp (setq icicle-input-fail-pos (min pos icicle-input-fail-pos)))
4980 pos (if matchp (+ pos delta) (- pos delta))))
4981 (unless (or (< pos input-start) (> pos icicle-input-fail-pos))
4982 (cond (icicle-input-completion-fail-overlay ; Don't recreate if exists.
4983 (move-overlay icicle-input-completion-fail-overlay (1- icicle-input-fail-pos) (point-max))
4984 (overlay-put icicle-input-completion-fail-overlay
4985 'face (if (icicle-require-match-p)
4986 'icicle-input-completion-fail
4987 'icicle-input-completion-fail-lax)))
4989 (setq icicle-input-completion-fail-overlay (make-overlay (1- icicle-input-fail-pos)
4991 (overlay-put icicle-input-completion-fail-overlay
4992 'face (if (icicle-require-match-p)
4993 'icicle-input-completion-fail
4994 'icicle-input-completion-fail-lax)))))
4995 input)) ; Return part of INPUT that matches.
4997 (defun icicle-ms-windows-NET-USE (drive)
4998 "Return result of calling MS Windows `NET USE' command on DRIVE.
4999 DRIVE is a Windows drive name, such as `f:'.
5000 A return value of zero means DRIVE is a mapped network drive."
5001 (if (and (fboundp 'hash-table-p) (hash-table-p icicle-ms-windows-drive-hash))
5002 (let ((lookup (gethash drive icicle-ms-windows-drive-hash 'no-assoc)))
5003 (if (eq lookup 'no-assoc)
5004 (puthash drive (call-process shell-file-name nil nil nil shell-command-switch
5005 (concat "NET USE " drive)) icicle-ms-windows-drive-hash)
5007 ;; Don't bother to hash for Emacs 20, 21, unless `cl.el' happens to be loaded.
5008 (call-process shell-file-name nil nil nil shell-command-switch (concat "NET USE " drive))))
5010 ;; $$$$$ TRYING WITHOUT `save-match-data', but probably need it.
5011 (defun icicle-file-remote-p (file)
5012 "Non-nil means FILE is likely to name a file on a remote system.
5013 For MS Windows, this includes a file on a mapped network drive.
5014 Otherwise, this uses `ffap-file-remote-p' and `file-remote-p' (if
5016 ;; $$$$ (save-match-data ; $$$$$ IS THIS NEEDED?
5017 (if (and (eq system-type 'windows-nt)
5018 (let ((case-fold-search t)) (string-match "\\`\\([a-z]:\\)" file)))
5019 (eq 0 (condition-case nil
5020 (icicle-ms-windows-NET-USE (match-string 1 file))
5022 (or (and (fboundp 'ffap-file-remote-p) (ffap-file-remote-p file))
5023 (and (fboundp 'file-remote-p) (file-remote-p file)))))
5025 ;;; $$$$$ Should these `*-any-*' fns call `icicle-transform-candidates'? For now, no, to save time.
5026 (defun icicle-any-candidates-p (input)
5027 "Return non-nil if there is any completion for INPUT, nil otherwise."
5029 (funcall (case icicle-current-completion-mode
5030 (apropos (if (icicle-file-name-input-p)
5031 #'icicle-apropos-any-file-name-candidates-p
5032 #'icicle-apropos-any-candidates-p))
5033 (otherwise (if (icicle-file-name-input-p)
5034 #'icicle-prefix-any-file-name-candidates-p
5035 #'icicle-prefix-any-candidates-p)))
5039 (defun icicle-prefix-any-candidates-p (input)
5040 "Return non-nil if current partial INPUT has prefix completions."
5041 (let ((minibuffer-completion-table minibuffer-completion-table)
5042 (minibuffer-completion-predicate minibuffer-completion-predicate))
5043 (if (icicle-not-basic-prefix-completion-p)
5044 (icicle-completion-try-completion input minibuffer-completion-table
5045 minibuffer-completion-predicate
5046 ;; $$$$$$ (- (point) (field-beginning)))
5048 (and (fboundp 'completion--field-metadata) ; Emacs 24
5049 (completion--field-metadata (field-beginning))))
5050 (try-completion input minibuffer-completion-table minibuffer-completion-predicate))))
5052 (defun icicle-prefix-any-file-name-candidates-p (input)
5053 "Return non-nil if partial file-name INPUT has prefix completions."
5054 (let* ((minibuffer-completion-table minibuffer-completion-table)
5055 (minibuffer-completion-predicate minibuffer-completion-predicate))
5056 (if (icicle-not-basic-prefix-completion-p)
5057 (icicle-completion-try-completion input minibuffer-completion-table
5058 minibuffer-completion-predicate
5060 (and (fboundp 'completion--field-metadata) ; Emacs 24
5061 (completion--field-metadata (field-beginning))))
5062 (try-completion input minibuffer-completion-table default-directory))))
5064 (defun icicle-apropos-any-candidates-p (input)
5065 "Return non-nil if current partial INPUT has apropos completions."
5066 (when icicle-regexp-quote-flag (setq input (regexp-quote input)))
5067 (let* ((minibuffer-completion-table minibuffer-completion-table)
5068 (minibuffer-completion-predicate minibuffer-completion-predicate)
5069 (all (icicle-all-completions "" minibuffer-completion-table
5070 minibuffer-completion-predicate
5071 icicle-ignore-space-prefix-flag)))
5072 (catch 'icicle-apropos-any-candidates-p
5074 ;; Assume no match if error - e.g. due to `string-match' with binary data in Emacs 20.
5075 ;; Do this everywhere we call `icicle-apropos-complete-match-fn'.
5076 (when (condition-case nil (funcall icicle-apropos-complete-match-fn input cand) (error nil))
5077 (throw 'icicle-apropos-any-candidates-p cand)))
5080 (defun icicle-apropos-any-file-name-candidates-p (input)
5081 "Return non-nil if partial file-name INPUT has apropos completions."
5082 (when (and input (not (string= "" input)) (eq (aref input (1- (length input))) ?\/))
5083 (setq input (substring input 0 (1- (length input))))) ; So we don't non-match highlight the /.
5084 (let* ((default-directory (icicle-file-name-directory-w-default input))
5085 (minibuffer-completion-table minibuffer-completion-table)
5086 (minibuffer-completion-predicate minibuffer-completion-predicate))
5087 (setq input (or (icicle-file-name-nondirectory input) ""))
5089 (progn (when icicle-regexp-quote-flag (setq input (regexp-quote input)))
5090 (let ((candidates (icicle-all-completions "" minibuffer-completion-table
5091 minibuffer-completion-predicate
5092 icicle-ignore-space-prefix-flag))
5093 (case-fold-search (if (boundp 'read-file-name-completion-ignore-case)
5094 read-file-name-completion-ignore-case
5095 completion-ignore-case)))
5096 (catch 'icicle-apropos-any-file-name-candidates-p
5097 (dolist (cand candidates)
5098 (when (if (member cand '("../" "./"))
5099 (member input '(".." ".")) ; Prevent "" from matching "../"
5100 (and (or (not icicle-apropos-complete-match-fn)
5101 ;; Assume no match if error - e.g. due to `string-match' with
5102 ;; binary data in Emacs 20. Do this everywhere we call
5103 ;; `icicle-apropos-complete-match-fn'.
5105 (funcall icicle-apropos-complete-match-fn input cand)
5107 (throw 'icicle-apropos-any-file-name-candidates-p cand)))
5109 (quit (top-level))))) ; Let `C-g' stop it.
5111 (defun icicle-clear-minibuffer ()
5112 "Delete all user input in the minibuffer.
5113 This must be called from the minibuffer."
5114 (if (fboundp 'delete-minibuffer-contents) (delete-minibuffer-contents) (erase-buffer)))
5116 ;; Same as `delete-dups' from Emacs 22+.
5117 (if (fboundp 'delete-dups)
5118 (defalias 'icicle-delete-dups (symbol-function 'delete-dups))
5119 (defun icicle-delete-dups (list)
5120 "Destructively remove `equal' duplicates from LIST.
5121 Store the result in LIST and return it. LIST must be a proper list.
5122 Of several `equal' occurrences of an element in LIST, the first
5126 (setcdr tail (delete (car tail) (cdr tail)))
5127 (setq tail (cdr tail))))
5130 ;; Borrowed from `ps-print.el'
5131 (defun icicle-remove-duplicates (list)
5132 "Copy of LIST with duplicate elements removed. Tested with `equal'."
5136 (unless (member (car tail) new) (push (car tail) new))
5140 (defun icicle-remove-dups-if-extras (list)
5141 "`icicle-remove-duplicates' if `icicle-extra-candidates' is non-nil.
5142 If `icicle-extra-candidates' is nil, then return LIST.
5144 Note: When you use this as the value of `icicle-transform-function',
5145 be aware that during completion and before applying this function,
5146 `icicle-extra-candidates' is redefined locally by removing its
5147 candidates that don't match the current input. So this function then
5148 has the effect of removing any duplicates that match the input. If
5149 there are no such matching candidates, then LIST is returned."
5150 (if icicle-extra-candidates
5154 (unless (member (car tail) new) (push (car tail) new))
5159 (defun icicle-file-readable-p (file)
5160 "Return non-nil if FILE (a string) names a readable file."
5161 (and (not (string= "" file)) (file-readable-p file) (not (file-directory-p file))))
5163 (defun icicle-file-writable-p (file)
5164 "Return non-nil if FILE (a string) names a writable file."
5165 (and (not (string= "" file)) (file-writable-p file) (not (file-directory-p file))))
5167 (defvar icicle-dirs-done ()
5168 "Directories already processed.")
5170 (defun icicle-files-within (file-list accum &optional no-symlinks-p)
5171 "List of all readable files in FILE-LIST.
5172 Accessible directories in FILE-LIST are processed recursively to
5173 include their files and the files in their subdirectories.
5175 Optional arg NO-SYMLINKS-P non-nil means do not follow symbolic links.
5177 The list of files is accumulated in ACCUM, which is used for recursive
5179 Bind `icicle-dirs-done' for use as free var elsewhere."
5180 (let ((icicle-dirs-done ()))
5181 (icicle-files-within-1 file-list accum no-symlinks-p)))
5183 (defun icicle-files-within-1 (file-list accum no-symlinks-p) ; `icicle-dirs-done' is free here.
5184 "Helper for `icicle-files-within'."
5188 (setq file (car file-list))
5189 (unless (and no-symlinks-p (file-symlink-p file))
5190 (if (file-directory-p file)
5191 ;; Skip directory if ignored, already treated, or inaccessible.
5192 (when (and (not (member (file-name-nondirectory file) icicle-ignored-directories))
5193 (not (member (file-truename file) icicle-dirs-done))
5194 (file-accessible-directory-p file))
5195 (setq res (icicle-files-within-1 (directory-files file 'full icicle-re-no-dot)
5198 (push (file-truename file) icicle-dirs-done))
5199 (when (file-readable-p file) (setq res (cons file res)))))
5203 (defun icicle-delete-whitespace-from-string (string &optional from to)
5204 "Remove whitespace from substring of STRING from FROM to TO.
5205 If FROM is nil, then start at the beginning of STRING (FROM = 0).
5206 If TO is nil, then end at the end of STRING (TO = length of STRING).
5207 FROM and TO are zero-based indexes into STRING.
5208 Character FROM is affected (possibly deleted). Character TO is not."
5209 (setq from (or from 0)
5210 to (or to (length string)))
5213 (goto-char (+ from (point-min)))
5216 (while (and (not (eobp)) (< count to))
5217 (setq char (char-after))
5218 (if (memq char '(?\ ?\t ?\n)) (delete-char 1) (forward-char 1))
5219 (setq count (1+ count)))
5222 (defun icicle-barf-if-outside-minibuffer ()
5223 "Raise an error if `this-command' is called outside the minibuffer."
5224 (unless (eq (current-buffer) (window-buffer (minibuffer-window)))
5225 (error "Command `%s' must be called from the minibuffer" this-command)))
5227 (defun icicle-barf-if-outside-Completions ()
5228 "Raise error if `this-command' is called outside buffer `*Completions*'."
5229 (unless (eq (current-buffer) (get-buffer "*Completions*"))
5230 (error "Command `%s' must be called from `*Completions*' buffer" this-command)))
5232 (defun icicle-barf-if-outside-Completions-and-minibuffer ()
5233 "Error if `this-command' called outside `*Completions*' and minibuffer."
5234 (unless (or (eq (current-buffer) (window-buffer (minibuffer-window)))
5235 (eq (current-buffer) (get-buffer "*Completions*")))
5236 (error "`%s' must be called from `*Completions*' or the minibuffer" this-command)))
5238 (defun icicle-command-abbrev-save ()
5239 "Save `icicle-command-abbrev-alist'. Used on `kill-emacs-hook'."
5240 (icicle-condition-case-no-debug err ; Don't raise an error, since it's on `kill-emacs-hook.
5241 (let ((sav (get 'icicle-command-abbrev-alist 'saved-value)))
5242 (unless (and (or (null sav)
5243 (and (consp sav) (consp (car sav)) (consp (cdar sav))
5244 (consp (car (cdar sav)))))
5245 (equal icicle-command-abbrev-alist (car (cdar sav))))
5246 (funcall icicle-customize-save-variable-function 'icicle-command-abbrev-alist
5247 icicle-command-abbrev-alist)))
5248 (error (message "Cannot save new value of `icicle-command-abbrev-alist'") (sleep-for 3))))
5250 (defun icicle-expand-file-or-dir-name (input dir)
5251 "Expand file-name INPUT in directory DIR.
5252 Similar to `expand-file-name', except:
5254 - If INPUT does not end in a slash, and DIR/INPUT is a directory,
5255 add a trailing slash.
5257 - If INPUT ends in a slash, but DIR/INPUT is not a directory, then
5258 remove the trailing slash.
5260 - if INPUT or DIR contains consecutive slashes (`/'), do not collapse
5261 them to a single slash."
5262 (let ((expanded-input (directory-file-name (icicle-expand-file-name-20 input dir))))
5263 ;; Add trailing slash if input is a directory.
5264 (when (file-directory-p expanded-input)
5265 (setq expanded-input (file-name-as-directory expanded-input)))
5268 (defun icicle-expand-file-name-20 (input dir)
5269 "Emacs 20's `expand-file-name': does not collapse consecutive slashes."
5270 ;; Replace // with five ^Gs, then replace back again.
5271 (let ((escaped-input (and input (replace-regexp-in-string "//" (make-string 5 7) input)))
5272 (escaped-dir (and dir (replace-regexp-in-string "//" (make-string 5 7) dir))))
5273 (replace-regexp-in-string (make-string 5 7) "//" (expand-file-name escaped-input escaped-dir))))
5275 (defun icicle-start-of-candidates-in-Completions ()
5276 "Return buffer position of the first candidate in `*Completions*'."
5278 (goto-char (point-min))
5279 (forward-line (if icicle-show-Completions-help-flag 2 1))
5282 (defun icicle-key-description (keys &optional no-angles)
5283 "`key-description', but non-nil NO-ANGLES means use no angle brackets."
5284 (let ((result (key-description keys)))
5285 (when no-angles ; Assume space separates angled keys.
5286 (setq result (replace-regexp-in-string "<\\([^>]+\\)>" "\\1" result 'fixed-case)))
5290 ;; (defun icicle-alist-delete-all (key alist &optional test)
5291 ;; "Delete from ALIST all elements whose car is the same as KEY.
5292 ;; Optional arg TEST is the equality test to use. If nil, `eq' is used.
5293 ;; Return the modified alist.
5294 ;; Elements of ALIST that are not conses are ignored."
5295 ;; (setq test (or test #'eq))
5296 ;; (while (and (consp (car alist)) (funcall test (car (car alist)) key))
5297 ;; (setq alist (cdr alist)))
5298 ;; (let ((tail alist) tail-cdr)
5299 ;; (while (setq tail-cdr (cdr tail))
5300 ;; (if (and (consp (car tail-cdr)) (funcall test (car (car tail-cdr)) key))
5301 ;; (setcdr tail (cdr tail-cdr))
5302 ;; (setq tail tail-cdr))))
5305 ;; Standard Emacs 21+ function, defined here for Emacs 20.
5306 (unless (fboundp 'assq-delete-all)
5307 (defun assq-delete-all (key alist)
5308 "Delete from ALIST all elements whose car is `eq' to KEY.
5309 Return the modified alist.
5310 Elements of ALIST that are not conses are ignored."
5311 (while (and (consp (car alist)) (eq (car (car alist)) key)) (setq alist (cdr alist)))
5312 (let ((tail alist) tail-cdr)
5313 (while (setq tail-cdr (cdr tail))
5314 (if (and (consp (car tail-cdr)) (eq (car (car tail-cdr)) key))
5315 (setcdr tail (cdr tail-cdr))
5316 (setq tail tail-cdr))))
5319 (defun icicle-first-N (n list)
5320 "Return a new list of at most the N first elements of LIST."
5322 (while (and list (> n 0))
5323 (push (car list) firstN)
5326 (setq firstN (nreverse firstN))))
5328 (defun icicle-abbreviate-or-expand-file-name (filename &optional dir)
5329 "Expand FILENAME, and abbreviate it if `icicle-use-~-for-home-dir-flag'.
5330 If FILENAME is not absolute, call `icicle-expand-file-name-20' to make
5331 it absolute. This does not collapse consecutive slashes (`/').
5332 If `icicle-use-~-for-home-dir-flag', call `abbreviate-file-name'.
5334 If DIR is absolute, pass it to `icicle-expand-file-name-20'.
5335 Otherwise, ignore it (treat it as nil)."
5336 (unless (file-name-absolute-p filename)
5337 (when (and dir (not (file-name-absolute-p dir))) (setq dir nil)) ; Don't use a relative dir.
5338 (setq filename (icicle-expand-file-name-20 filename dir)))
5339 (if icicle-use-~-for-home-dir-flag (abbreviate-file-name filename) filename))
5341 (defun icicle-reversible-sort (list &optional key)
5342 "`sort' LIST using `icicle-sort-comparer'.
5343 Reverse the result if `icicle-reverse-sort-p' is non-nil.
5344 If `icicle-sort-comparer' is a cons (other than a lambda form), then
5345 use `icicle-multi-sort' as the sort predicate.
5346 Otherwise, use `icicle-sort-comparer' as the sort predicate.
5348 Optional arg KEY is a selector function to apply to each item to be be
5349 compared. If nil, then the entire item is used."
5350 ;;$$ (when (and icicle-edit-update-p icicle-completion-candidates
5351 ;; (> (length icicle-completion-candidates) icicle-incremental-completion-threshold))
5352 ;; (message "Sorting candidates..."))
5353 (unless key (setq key 'identity))
5354 (let ((sort-fn (and icicle-sort-comparer
5356 (when icicle-transform-before-sort-p
5357 (setq s1 (icicle-transform-multi-completion s1)
5358 s2 (icicle-transform-multi-completion s2)))
5359 ;; If we have an inappropriate sort order, get rid of it. This can happen if
5360 ;; the user chooses a sort appropriate to one kind of candidate and then
5361 ;; tries completion for a different kind of candidate.
5363 (and icicle-sort-comparer ; nil in case of error earlier in list.
5364 (if (and (not (functionp icicle-sort-comparer))
5365 (consp icicle-sort-comparer))
5366 (icicle-multi-sort (funcall key s1) (funcall key s2))
5367 (funcall icicle-sort-comparer (funcall key s1) (funcall key s2))))
5368 (error (message "Inappropriate sort order - reverting to unsorted")
5370 (setq icicle-sort-comparer nil)
5373 (setq list (sort list (if icicle-reverse-sort-p
5374 (lambda (a b) (not (funcall sort-fn a b)))
5378 ;; Essentially the same as `bmkp-multi-sort'.
5379 (defun icicle-multi-sort (s1 s2)
5380 "Try predicates in `icicle-sort-comparer', in order, until one decides.
5381 The (binary) predicates are applied to S1 and S2.
5382 See the description of `icicle-sort-comparer'.
5383 If `icicle-reverse-multi-sort-p' is non-nil, then reverse the order
5384 for using multi-sorting predicates."
5385 (let ((preds (car icicle-sort-comparer))
5386 (final-pred (cadr icicle-sort-comparer))
5388 (when icicle-reverse-multi-sort-p (setq preds (reverse preds)))
5389 (catch 'icicle-multi-sort
5390 (dolist (pred preds)
5391 (setq result (funcall pred s1 s2))
5392 (when (consp result)
5393 (when icicle-reverse-multi-sort-p (setq result (list (not (car result)))))
5394 (throw 'icicle-multi-sort (car result))))
5395 (and final-pred (if icicle-reverse-multi-sort-p
5396 (not (funcall final-pred s1 s2))
5397 (funcall final-pred s1 s2))))))
5399 (defun icicle-make-plain-predicate (pred &optional final-pred)
5400 "Return a plain predicate that corresponds to component-predicate PRED.
5401 PRED and FINAL-PRED correspond to their namesakes in
5402 `icicle-sort-comparer' (which see).
5404 PRED should return `(t)', `(nil)', or nil.
5406 Optional arg FINAL-PRED is the final predicate to use if PRED cannot
5407 decide (returns nil). If FINAL-PRED is nil, then `icicle-alpha-p' is
5408 used as the final predicate."
5410 (let ((res (funcall ',pred b1 b2)))
5411 (if res (car res) (funcall ',(or final-pred 'icicle-alpha-p) b1 b2)))))
5413 (defun icicle-alpha-p (s1 s2)
5414 "True if string S1 sorts alphabetically before string S2.
5415 Comparison respects `case-fold-search'."
5416 (when case-fold-search (setq s1 (icicle-upcase s1)
5417 s2 (icicle-upcase s2)))
5418 (string-lessp s1 s2))
5420 (defun icicle-get-alist-candidate (string &optional no-error-p)
5421 "Return full completion candidate that corresponds to displayed STRING.
5422 STRING is the name of the candidate, as shown in `*Completions*'.
5423 Non-nil optional argument NO-ERROR-P means display a message and
5424 return nil instead of raising an error if STRING is ambiguous.
5425 If the value of NO-ERROR-P is `no-error-no-msg', then show no message
5426 and just return nil.
5428 If `icicle-whole-candidate-as-text-prop-p' is non-nil, then the full
5429 candidate might be available as text property `icicle-whole-candidate'
5430 of STRING. If so, then that is used.
5432 Otherwise, the full candidate is obtained from
5433 `icicle-candidates-alist'. In this case:
5434 If the user cycled among candidates or used `mouse-2', then use the
5435 current candidate number, and ignore STRING.
5437 If only one candidate matches STRING, use that.
5438 Else respect NO-ERROR-P and tell user to use cycling or `mouse-2'."
5439 (or (and icicle-whole-candidate-as-text-prop-p
5440 (get-text-property 0 'icicle-whole-candidate string))
5441 (and icicle-candidates-alist
5442 (let ((cand-entries (icicle-filter-alist icicle-candidates-alist
5443 icicle-completion-candidates)))
5444 (if (wholenump icicle-candidate-nb) ; Cycled or used `mouse-2' to choose the candidate.
5445 (elt cand-entries (mod icicle-candidate-nb (length icicle-candidates-alist)))
5446 ;; If `icicle-completion-candidates' is nil, because user didn't use `TAB' or `S-TAB',
5447 ;; then `icicle-candidates-alist' can contain non-matches. So, we check for more than
5448 ;; one match. However, we cannot just use `assoc', because candidates might be
5449 ;; multi-completions (lists).
5450 (let ((first-match (icicle-first-matching-candidate string icicle-candidates-alist)))
5451 (if (and first-match
5452 (not (icicle-first-matching-candidate
5454 (setq cand-entries (delete first-match cand-entries)))))
5455 first-match ; Only one match, so use it.
5456 (let ((msg "Ambiguous choice. Cycle or use `mouse-2' to choose unique matching \
5458 (unless no-error-p (error msg))
5459 (unless (eq no-error-p 'no-error-no-msg) (icicle-msg-maybe-in-minibuffer msg))
5460 nil)))))))) ; Return nil for ambiguous string if NO-ERROR-P.
5462 (defun icicle-filter-alist (alist filter-keys)
5463 "Filter ALIST, keeping items whose cars match FILTER-KEYS, in order.
5464 The original ALIST is not altered; a copy is filtered and returned.
5465 If FILTER-KEYS is empty, then ALIST is returned, not a copy."
5467 (icicle-remove-if-not
5469 (member (if (consp (car item))
5470 ;; $$$$$$ (concat (mapconcat #'identity (car item) icicle-list-join-string)
5471 ;; icicle-list-end-string) ; $$$$$$
5472 (mapconcat #'identity (car item) icicle-list-join-string)
5478 ;;; $$$$$$$$$$$$$$$$$$
5479 ;;; (defun icicle-first-matching-candidate (cand candidates)
5480 ;;; "Return the first element of alist CANDIDATES that matches CAND.
5481 ;;; If CANDIDATES is a normal list of completion candidates, then this is
5483 ;;; If CANDIDATES contains multi-completions, then matching means matching
5484 ;;; the concatenated multi-completion parts, joined by
5485 ;;; `icicle-list-join-string'."
5486 ;;; (cond ((null candidates) nil)
5487 ;;; ((if (consp (caar candidates)) ; Multi-completion candidate
5488 ;;; (save-match-data
5489 ;;; (string-match cand (mapconcat #'identity (caar candidates)
5490 ;;; icicle-list-join-string)))
5491 ;;; (equal cand (caar candidates))) ; This case is just `assoc'.
5492 ;;; (car candidates))
5493 ;;; (t (icicle-first-matching-candidate cand (cdr candidates)))))
5495 (defun icicle-first-matching-candidate (cand candidates)
5496 "Return the first element of alist CANDIDATES that matches CAND.
5497 Return nil if there is no such element.
5498 If CANDIDATES is a normal list of completion candidates, then this is
5500 If CANDIDATES contains multi-completions, then matching means matching
5501 the concatenated multi-completion parts, joined by
5502 `icicle-list-join-string'."
5504 (if (null candidates)
5506 (while (and candidates (not res))
5507 (when (or (and (consp (caar candidates)) ; Multi-completion candidate
5509 (string-match (regexp-quote cand)
5510 ;; $$$$$$ (concat (mapconcat #'identity (caar candidates)
5511 ;; icicle-list-join-string)
5512 ;; icicle-list-end-string) ; $$$$$$
5513 (mapconcat #'identity (caar candidates)
5514 icicle-list-join-string))))
5515 (equal cand (caar candidates)))
5516 (setq res (car candidates)))
5517 (setq candidates (cdr candidates))))
5520 (defun icicle-completing-p ()
5521 "Non-nil if reading minibuffer input with completion.
5522 This caches the value returned in variable `icicle-completing-p'.
5523 Use the function, not the variable, to test, if not sure to be in the
5525 (setq icicle-completing-p ; Cache the value.
5526 (and (active-minibuffer-window)
5527 ;; $$$ (where-is-internal 'icicle-candidate-action nil 'first-only)
5528 (let* ((loc-map (current-local-map))
5529 (parent (keymap-parent loc-map))
5530 (maps (cond ((boundp 'minibuffer-local-filename-must-match-map)
5531 (list minibuffer-local-completion-map
5532 minibuffer-local-must-match-map
5533 minibuffer-local-filename-completion-map
5534 minibuffer-local-filename-must-match-map))
5535 ((boundp 'minibuffer-local-must-match-filename-map)
5536 (list minibuffer-local-completion-map
5537 minibuffer-local-must-match-map
5538 minibuffer-local-filename-completion-map
5539 minibuffer-local-must-match-filename-map))
5540 ((boundp 'minibuffer-local-filename-completion-map)
5541 (list minibuffer-local-completion-map
5542 minibuffer-local-must-match-map
5543 minibuffer-local-filename-completion-map))
5545 (list minibuffer-local-completion-map
5546 minibuffer-local-must-match-map)))))
5547 (and (or (and parent (member parent maps)) (member loc-map maps))
5548 t))))) ; Cache t, not the keymap portion.
5550 ;; This is just `substring-no-properties', defined also for Emacs < 22.
5551 (defun icicle-substring-no-properties (string &optional from to)
5552 "Return a substring of STRING, without text properties.
5553 It starts at index FROM and ending before TO.
5554 TO may be nil or omitted; then the substring runs to the end of STRING.
5555 If FROM is nil or omitted, the substring starts at the beginning of STRING.
5556 If FROM or TO is negative, it counts from the end.
5558 With one argument, just copy STRING without its properties."
5559 (if (fboundp 'substring-no-properties)
5560 (substring-no-properties string from to) ; Emacs 22.
5561 (let ((substrg (copy-sequence (substring string (or from 0) to))))
5562 (set-text-properties 0 (length substrg) nil substrg)
5565 (defun icicle-highlight-lighter ()
5566 "Highlight `Icy' mode-line indicator of Icicle mode.
5567 Highlighting indicates the current completion status."
5568 (when icicle-highlight-lighter-flag
5570 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
5571 (if (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
5572 (boundp 'read-file-name-completion-ignore-case))
5573 read-file-name-completion-ignore-case
5574 completion-ignore-case)
5577 (face (cond ((and icicle-candidate-action-fn (icicle-require-match-p))
5578 '(icicle-multi-command-completion icicle-mustmatch-completion))
5579 (icicle-candidate-action-fn 'icicle-multi-command-completion)
5580 ((icicle-require-match-p)
5581 '(icicle-completion icicle-mustmatch-completion))
5582 (t 'icicle-completion))))
5583 (when icicle-candidate-action-fn (setq strg (concat strg "+")))
5584 (put-text-property 0 (length strg) 'face face strg)
5585 (icicle-clear-lighter)
5586 (add-to-list 'minor-mode-alist `(icicle-mode ,strg)))
5588 (if (fboundp 'redisplay) (redisplay t) (force-mode-line-update t))
5589 (error nil)))) ; Ignore errors from, e.g., killed buffers.
5591 (defun icicle-unhighlight-lighter ()
5592 "Unhighlight `Icy' mode-line indicator of Icicle mode."
5593 (when icicle-highlight-lighter-flag
5594 (let ((strg (if case-fold-search " ICY" " Icy")))
5595 (icicle-clear-lighter)
5596 (add-to-list 'minor-mode-alist `(icicle-mode ,strg)))
5598 (if (fboundp 'redisplay) (redisplay t) (force-mode-line-update t))
5599 (error nil)))) ; Ignore errors from, e.g., killed buffers.
5601 (defun icicle-clear-lighter (&optional only)
5602 "Remove Icicle mode lighter from `minor-mode-alist'."
5603 (unless (eq only 'truncated)
5604 (setq minor-mode-alist (delete '(icicle-mode " Icy") minor-mode-alist)
5605 minor-mode-alist (delete '(icicle-mode " Icy+") minor-mode-alist)
5606 minor-mode-alist (delete '(icicle-mode " ICY") minor-mode-alist)
5607 minor-mode-alist (delete '(icicle-mode " ICY+") minor-mode-alist)))
5608 (unless (eq only 'not-truncated)
5609 (setq minor-mode-alist (delete `(icicle-mode ,(concat " Icy" icicle-lighter-truncation))
5611 minor-mode-alist (delete `(icicle-mode ,(concat " Icy+" icicle-lighter-truncation))
5613 minor-mode-alist (delete `(icicle-mode ,(concat " ICY" icicle-lighter-truncation))
5615 minor-mode-alist (delete `(icicle-mode ,(concat " ICY+" icicle-lighter-truncation))
5616 minor-mode-alist))))
5618 (defun icicle-ding ()
5619 "Same as `ding', but respects `icicle-inhibit-ding-flag'."
5620 (unless icicle-inhibit-ding-flag (ding)))
5622 (defun icicle-kill-a-buffer (buf &optional nomsg)
5624 Optional arg NOMSG non-nil means don't display an error message."
5625 (save-selected-window
5626 (setq buf (get-buffer buf))
5628 (icicle-condition-case-no-debug err
5629 (if (not (buffer-live-p buf))
5630 (unless nomsg (message "Buffer already deleted: `%s'" buf))
5631 (let ((enable-recursive-minibuffers t)) ; In case called from minibuffer, and modified.
5632 (if (fboundp 'kill-buffer-and-its-windows)
5633 (kill-buffer-and-its-windows buf) ; Defined in `misc-cmds.el'.
5634 (kill-buffer buf))))
5636 (unless nomsg (message "No such live buffer: `%s'" buf)))))
5638 (defun icicle-unpropertize (string)
5639 "Remove text properties from STRING.
5640 If STRING is not a string, just return it (raise no error).
5641 If `icicle-remove-icicles-props-p' is nil, just return STRING. This
5642 is the case for some Icicles functions that need to further process
5643 the completion result.
5644 Otherwise, if option `icicle-unpropertize-completion-result-flag' is
5645 non-nil, then remove all text properties.
5646 Otherwise remove only Icicles internal text properties:
5647 1. any text properties in `icicle-candidate-properties-alist'.
5648 2. The following internal text properties added by Icicles:
5649 `display', `help-echo', `icicle-fancy-candidates',
5650 `icicle-keep-newline', `icicle-mode-line-help',
5651 `icicle-special-candidate', `icicle-user-plain-dot',
5652 `icicle-whole-candidate', `invisible'.
5653 \(Property `mouse-face' is removed by `choose-completion-string'.\)"
5654 (when (and (stringp string) icicle-remove-icicles-props-p) ; Do nothing if we're inhibiting removal.
5655 (let ((len (length string)))
5656 (if icicle-unpropertize-completion-result-flag
5657 (set-text-properties 0 len nil string)
5658 (remove-text-properties
5659 0 len '(display nil help-echo nil icicle-fancy-candidates nil icicle-keep-newline nil
5660 icicle-mode-line-help nil icicle-special-candidate nil icicle-user-plain-dot nil
5661 icicle-whole-candidate nil invisible nil)
5663 (dolist (entry icicle-candidate-properties-alist)
5664 (put-text-property 0 len (car (cadr entry)) nil string)))))
5667 (defun icicle-isearch-complete-past-string ()
5668 "Set `isearch-string' to a past search string chosen by completion."
5669 (isearch-done 'nopush)
5670 (let ((icicle-whole-candidate-as-text-prop-p nil)
5671 (completion-ignore-case case-fold-search)
5672 (enable-recursive-minibuffers t))
5673 (setq isearch-string
5675 "Search string (completing): "
5676 (mapcar #'list (icicle-remove-duplicates (symbol-value (if isearch-regexp
5679 nil nil isearch-string (if isearch-regexp 'regexp-search-ring 'search-ring)))))
5681 ;; $$$$$$ Filed Emacs BUG #8795. They added a non-optional arg, METADATA (with no doc).
5683 (defun icicle-completion-all-completions (string table pred point &optional metadata)
5684 "Icicles version of `completion-all-completions'.
5685 1. Handle all Emacs versions.
5686 2. Append `$' to each candidate, if current input ends in `$'.
5687 3. Remove the last cdr, which might hold the base size.
5688 4. METADATA is optional and defaults to `completion--field-metadata'
5689 at `field-beginning'."
5690 (let* ((mdata (and (fboundp 'completion--field-metadata)
5691 (or metadata (completion--field-metadata (field-beginning)))))
5692 ;; $$$$$$$$ UNLESS BUG #8795 is fixed, need METADATA even if nil.
5693 (res (if (fboundp 'completion--field-metadata) ; Emacs 24 added a 5th arg, METADATA.
5694 (completion-all-completions string table pred point mdata)
5695 (completion-all-completions string table pred point))))
5696 (when (consp res) (let ((last (last res))) (when last (setcdr last nil))))
5697 (let* ((input-sans-dir (icicle-minibuf-input-sans-dir icicle-current-input))
5698 (env-var-p (and (icicle-not-basic-prefix-completion-p)
5699 (> (length input-sans-dir) 0)
5700 (eq ?\$ (aref input-sans-dir 0)))))
5701 (when env-var-p (setq res (mapcar #'(lambda (cand) (concat "$" cand)) res))))
5704 ;; $$$$$$ Filed Emacs BUG #4708. `completion-try-completion' does not return nil when it should.
5705 ;; E.g. (completion-try-completion "c:/some-dir/$HOMj" nil 17) returns: ("c:/some-dir/$$HOMj" . 18)
5707 ;; This causes `icicle-highlight-input-noncompletion' not to highlight the `j' in the above example.
5709 ;; $$$$$$ Filed Emacs BUG #8795. They added a non-optional arg, METADATA (with no doc).
5711 (defun icicle-completion-try-completion (string table pred point &optional metadata)
5712 "Icicles version of `completion-try-completion'.
5713 1. Handle all Emacs versions.
5714 2. Remove the last cdr, which might hold the base size.
5715 3. METADATA is optional and defaults to `completion--field-metadata'
5716 at `field-beginning'."
5717 (let* ((mdata (and (fboundp 'completion--field-metadata)
5718 (or metadata (completion--field-metadata (field-beginning)))))
5719 ;; $$$$$$$$ UNLESS BUG #8795 is fixed, still need METADATA, even if nil.
5720 (res (if (fboundp 'completion--field-metadata) ; Emacs 24 added a 5th arg, METADATA.
5721 (completion-try-completion string table pred point mdata)
5722 (completion-try-completion string table pred point))))
5723 (when (consp res) (setq res (car res)))
5726 (defun icicle-require-match-p ()
5727 "Return non-nil if completion is strict.
5728 Return non-nil if current REQUIRE-MATCH arg to `completing-read' or
5729 `read-file-name' really means require match (sheesh!)."
5730 (if (> emacs-major-version 22) (eq t icicle-require-match-p) icicle-require-match-p))
5732 (defun icicle-candidate-short-help (help string)
5733 "Put string of text HELP on STRING as text properties.
5734 Put `help-echo' property if `tooltip-mode' is non-nil.
5735 Put `icicle-mode-line-help' property (on the first character only) if
5736 `icicle-help-in-mode-line-delay' is positive.
5737 Return STRING, whether propertized or not."
5738 (unless (equal "" string)
5739 (when (> icicle-help-in-mode-line-delay 0)
5740 (put-text-property 0 1 'icicle-mode-line-help help string))
5741 (when (and (boundp 'tooltip-mode) tooltip-mode)
5742 (put-text-property 0 (length string) 'help-echo help string)))
5745 ;; This is not used by Icicles, since the color functions require `hexrgb.el'.
5746 (defun icicle-remove-color-duplicates (list)
5747 "Copy of LIST with duplicate color candidates removed.
5748 Candidates are considered duplicates if they have the same color name,
5749 abstracting from whitespace and letter case."
5752 (save-match-data (while tail
5753 (let* ((this (car tail))
5754 (pseudo-color-p (string-match "^\*" this)))
5755 (string-match ": " this)
5756 (unless pseudo-color-p
5757 (setq this (icicle-delete-whitespace-from-string
5758 (downcase this) 0 (match-beginning 0))))
5759 (unless (member this new) (push this new)))
5764 (defmacro icicle-maybe-cached-action (action)
5765 "Evaluate and return ACTION or `icicle-all-candidates-action'.
5766 If `icicle-all-candidates-action' is nil, use ACTION.
5767 If it is t, then set it to the value of ACTION, so the next call
5768 returns the same value."
5769 `(if icicle-all-candidates-action
5770 (if (eq icicle-all-candidates-action t)
5771 (setq icicle-all-candidates-action ,action)
5772 icicle-all-candidates-action)
5775 (defun icicle-alt-act-fn-for-type (type)
5776 "Returns an action function chosen by user for type TYPE (a string).
5777 Typical use: Bind `icicle-candidate-alt-action-fn' and
5778 `icicle-all-candidates-list-alt-action-fn' to the return value.
5779 However, you must first bind `icicle-orig-window' to the window that
5780 is current before user input is read from the minibuffer."
5781 (lexical-let ((type type)) ; Does this binding really help?
5783 (unless (listp cands) (setq cands (list cands))) ; So it works for both single and all cands.
5784 (let* ((enable-recursive-minibuffers t)
5785 (anything-actions (and (> emacs-major-version 21)
5786 icicle-use-anything-candidates-flag
5787 (require 'anything nil t)
5788 (icicle-get-anything-actions-for-type
5790 (actions ; Must sort, for `icicle-candidates-alist',
5791 (sort ; or else `icicle-candidate-nb' will be wrong.
5792 (append anything-actions
5793 (mapcar (lambda (act) (cons (format "%s" act) act))
5794 (icicle-remove-if-not #'functionp
5795 (cdr (assoc ,type icicle-type-actions-alist)))))
5796 (lambda (a1 a2) (funcall 'string-lessp (car a1) (car a2)))))
5797 (icicle-sort-comparer 'string-lessp) ; Must be the same order as actions.
5798 (icicle-candidate-action-fn ; For "how".
5800 (let ((icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "function"))
5801 icicle-saved-completion-candidate)
5802 (icicle-with-selected-window
5803 (if (and (boundp 'icicle-orig-window) (window-live-p icicle-orig-window))
5805 (selected-window)) ; Punt wo `icicle-orig-window'.
5806 (dolist (cand cands)
5807 (setq icicle-saved-completion-candidate cand)
5808 (icicle-apply-to-saved-candidate fn t ,type))))))
5809 ;; Save & restore these, so `icomplete-exhibit' on `post-command-hook' has no error.
5810 (minibuffer-completion-table minibuffer-completion-table)
5811 (minibuffer-completion-predicate minibuffer-completion-predicate))
5813 (setq cands (mapcar (lambda (obj)
5814 (setq obj (icicle-transform-multi-completion obj))
5815 (cond ((not (stringp obj)) obj)
5816 ((memq (intern ,type)
5817 '(command face function option symbol variable))
5819 ((and (eq (intern ,type) 'frame) (fboundp 'get-a-frame))
5823 (setq icicle-candidates-alist actions)
5824 (let (icicle-saved-completion-candidate)
5825 (cond ((null actions)
5826 ;; Undefined TYPE - provide all Emacs `functionp' symbol names as candidates.
5827 (let* ((icicle-must-pass-after-match-predicate #'(lambda (s) (functionp (intern s))))
5828 (action (icicle-maybe-cached-action
5829 (completing-read "How (action): "
5831 (dolist (cand cands)
5832 (setq icicle-saved-completion-candidate cand)
5833 (icicle-apply-to-saved-candidate action))))
5834 ((null (cdr actions))
5835 (dolist (cand cands) (funcall (icicle-maybe-cached-action (cdar actions)) cand)))
5837 (let* ((icicle-show-Completions-initially-flag t)
5838 (action (icicle-maybe-cached-action
5839 (completing-read "How (action): "
5841 (icicle-with-selected-window
5842 (if (and (boundp 'icicle-orig-window) (window-live-p icicle-orig-window))
5844 (selected-window)) ; Punt: no `icicle-orig-window'.
5845 (let ((icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "function")))
5846 (dolist (cand cands)
5847 (setq icicle-saved-completion-candidate cand)
5848 (icicle-apply-to-saved-candidate action t ,type))))))))))))
5850 (defun icicle-toggle-icicle-mode-twice ()
5851 "Toggle Icicle mode twice. Load `icicles-mode.el' if not loaded."
5852 ;; Just a convenience function, to avoid Emacs warning about calling `icy-mode' with no arg.
5853 (require 'icicles-mode)
5854 (let ((curr (if (and (boundp 'icicle-mode) icicle-mode) 1 -1)))
5855 (icy-mode (- curr)) (icy-mode curr)))
5857 (defun icicle-current-TAB-method ()
5858 "Current completion method for \
5859 `\\<minibuffer-local-completion-map>\\[icicle-prefix-complete]'.
5860 This resets variable `icicle-current-TAB-method' when needed."
5861 (or (car (memq icicle-current-TAB-method icicle-TAB-completion-methods))
5862 (car icicle-TAB-completion-methods)))
5864 (defun icicle-not-basic-prefix-completion-p ()
5865 "`icicle-current-TAB-method' is `vanilla', and Emacs > release 22."
5866 (and (eq 'vanilla (icicle-current-TAB-method)) (boundp 'completion-styles)))
5868 (defun icicle-all-completions (string collection &optional predicate hide-spaces)
5869 "Version of vanilla `all-completions' that works for all Emacs releases.
5870 Starting with Emacs23.2, `all-completions' no longer accepts a fourth
5871 argument, so we drop that arg in that case."
5872 (condition-case nil ; Emacs 23.2+ has no 4th parameter.
5873 (all-completions string collection predicate hide-spaces)
5874 (wrong-number-of-arguments (all-completions string collection predicate))))
5876 ;;(@* "Icicles functions - sort functions")
5878 ;;; Icicles functions - sort functions -------------------------------
5880 (defun icicle-merge-saved-order-less-p (s1 s2)
5881 "String S1 has a lower index than S2 in current and saved candidates list."
5882 (let ((cs1 (icicle-position s1 icicle-completion-candidates))
5883 (cs2 (icicle-position s2 icicle-completion-candidates))
5884 (ss1 (icicle-position s1 icicle-saved-completion-candidates))
5885 (ss2 (icicle-position s2 icicle-saved-completion-candidates))
5887 (unless cs1 (error "`%s' is not currently a candidate" s1))
5888 (unless cs2 (error "`%s' is not currently a candidate" s2))
5889 (unless ss1 (setq ss1 (setq len (length icicle-saved-completion-candidates))))
5890 (unless ss2 (setq ss2 (or len (length icicle-saved-completion-candidates))))
5891 (< (+ cs1 ss1) (+ cs2 ss2))))
5893 (defun icicle-historical-alphabetic-p (s1 s2)
5894 "Non-nil means S1 is a past input and S2 is not or S1 < S2 (alphabet).
5895 Return non-nil if S1 is a previous input and either S2 is not or
5896 S1 `icicle-case-string-less-p' S2. S1 and S2 must be strings.
5898 When used as a comparison function for completion candidates, this
5899 makes candidates matching previous inputs available first (at the top
5900 of buffer `*Completions*'). Candidates are effectively in two groups,
5901 each of which is sorted alphabetically separately: matching previous
5902 inputs, followed by matching candidates that have not yet been used."
5903 ;; We could use `icicle-delete-duplicates' to shorten the history, but that takes time too.
5904 ;; And, starting in Emacs 22, histories will not contain duplicates anyway.
5905 (let ((hist (and (symbolp minibuffer-history-variable) (boundp minibuffer-history-variable)
5906 (symbol-value minibuffer-history-variable)))
5907 (dir (and (icicle-file-name-input-p)
5908 (icicle-file-name-directory-w-default (or icicle-last-input
5909 icicle-current-input)))))
5910 (if (not (consp hist))
5911 (icicle-case-string-less-p s1 s2)
5912 (when dir (setq s1 (expand-file-name s1 dir)
5913 s2 (expand-file-name s2 dir)))
5914 (let ((s1-previous-p (member s1 hist))
5915 (s2-previous-p (member s2 hist)))
5916 (or (and (not s1-previous-p) (not s2-previous-p) (icicle-case-string-less-p s1 s2))
5917 (and s1-previous-p (not s2-previous-p))
5918 (and s1-previous-p s2-previous-p (icicle-case-string-less-p s1 s2)))))))
5920 ;; $$ Alternative definition, but it doesn't seem any faster, and is slightly less clear.
5921 ;; (defun icicle-most-recent-first-p (s1 s2)
5922 ;; "Non-nil means S1 was used more recently than S2.
5924 ;; S1 < S2 if S1 was used previously but S2 was not.
5925 ;; S1 < S2 if neither was used previously
5926 ;; and S1 `icicle-case-string-less-p' S2."
5927 ;; ;; We could use `icicle-delete-duplicates' to shorten the history, but that takes time too.
5928 ;; ;; And, starting in Emacs 22, histories will not contain duplicates anyway.
5929 ;; (let ((hist (and (symbolp minibuffer-history-variable)
5930 ;; (symbol-value minibuffer-history-variable)))
5931 ;; (dir (and (icicle-file-name-input-p)
5932 ;; (icicle-file-name-directory-w-default
5933 ;; (or icicle-last-input icicle-current-input))))
5935 ;; (s2-in-hist nil))
5936 ;; (if (not (consp hist))
5937 ;; (icicle-case-string-less-p s1 s2)
5938 ;; (when dir (setq s1 (expand-file-name s1 dir) s2 (expand-file-name s2 dir)))
5939 ;; (while (and hist (not (setq s1-in-hist (equal s1 (car hist)))))
5940 ;; (when (setq s2-in-hist (equal s2 (car hist))) (setq hist nil))
5941 ;; (setq hist (cdr hist)))
5942 ;; (or (and hist s1-in-hist) (and (not s2-in-hist) (icicle-case-string-less-p s1 s2))))))
5944 (defun icicle-most-recent-first-p (s1 s2)
5945 "Non-nil means S1 was used more recently than S2.
5947 S1 < S2 if S1 was used previously but S2 was not.
5948 S1 < S2 if neither was used previously
5949 and S1 `icicle-case-string-less-p' S2."
5950 ;; We could use `icicle-delete-duplicates' to shorten the history, but that takes time too.
5951 ;; And, starting in Emacs 22, histories do not contain duplicates anyway.
5952 (let ((hist (and (symbolp minibuffer-history-variable) (boundp minibuffer-history-variable)
5953 (symbol-value minibuffer-history-variable)))
5954 (dir (and (icicle-file-name-input-p)
5955 (icicle-file-name-directory-w-default (or icicle-last-input
5956 icicle-current-input))))
5959 (if (not (consp hist))
5960 (icicle-case-string-less-p s1 s2)
5961 (when dir (setq s1 (expand-file-name s1 dir)
5962 s2 (expand-file-name s2 dir)))
5963 (setq s1-tail (member s1 hist)
5964 s2-tail (member s2 hist))
5965 (cond ((and s1-tail s2-tail) (>= (length s1-tail) (length s2-tail)))
5968 (t (icicle-case-string-less-p s1 s2))))))
5971 (put 'icicle-buffer-smaller-p 'icicle-buffer-sort-predicate t)
5972 ;; This predicate is used for buffer-name completion.
5973 (defun icicle-buffer-smaller-p (b1 b2)
5974 "Non-nil means buffer named B1 is smaller than buffer named B2."
5975 (< (with-current-buffer b1 (buffer-size)) (with-current-buffer b2 (buffer-size))))
5978 (put 'icicle-major-mode-name-less-p 'icicle-buffer-sort-predicate t)
5979 ;; This predicate is used for buffer-name completion.
5980 (defun icicle-major-mode-name-less-p (b1 b2)
5981 "Non-nil means major mode name of buffer B1 is `string-less-p' that of B2.
5982 If those names are identical, then buffer names are compared.
5983 Comparison is not case-sensitive."
5984 (let ((bm1 (icicle-upcase (symbol-name (with-current-buffer b1 major-mode))))
5985 (bm2 (icicle-upcase (symbol-name (with-current-buffer b2 major-mode)))))
5986 (if (string= bm1 bm2) (string-lessp b1 b2) (string-lessp bm1 bm2))))
5989 (when (fboundp 'format-mode-line) ; Emacs 22+
5990 (put 'icicle-mode-line-name-less-p 'icicle-buffer-sort-predicate t)
5991 ;; This predicate is used for buffer-name completion.
5992 (defun icicle-mode-line-name-less-p (b1 b2)
5993 "Non-nil means buffer B1 mode in mode line is `string-less-p' that of B2.
5994 If those names are identical, then buffer names are compared.
5995 Comparison is not case-sensitive."
5996 (let ((bm1 (icicle-upcase (with-current-buffer b1 (format-mode-line mode-name))))
5997 (bm2 (icicle-upcase (with-current-buffer b2 (format-mode-line mode-name)))))
5998 (if (string= bm1 bm2) (string-lessp b1 b2) (string-lessp bm1 bm2)))))
6001 (put 'icicle-buffer-file/process-name-less-p 'icicle-buffer-sort-predicate t)
6002 ;; This predicate is used for buffer-name completion.
6003 (defun icicle-buffer-file/process-name-less-p (b1 b2)
6004 "Non-nil means file/process name of buffer B1 is `string-less-p' that of B2.
6005 The absolute file name of a buffer is used, not the relative name.
6006 Comparison is case-insensitive on systems where file-name case is
6009 Buffers not associated with files or processes are sorted last."
6010 (setq b1 (get-buffer b1)
6012 (let ((fp-b1 (or (buffer-file-name b1) (let ((pb1 (get-buffer-process b1)))
6013 (and (processp pb1) (process-name pb1)))))
6014 (fp-b2 (or (buffer-file-name b2) (let ((pb2 (get-buffer-process b2)))
6015 (and (processp pb2) (process-name pb2))))))
6016 (and fp-b1 (or (not fp-b2)
6017 (if (memq system-type '(ms-dos windows-nt cygwin))
6018 (string-lessp (icicle-upcase fp-b1) (icicle-upcase fp-b2))
6019 (string-lessp fp-b1 fp-b2))))))
6022 (put 'icicle-file-type-less-p 'icicle-file-name-sort-predicate t)
6023 ;; This predicate is used for file-name completion.
6024 (defun icicle-file-type-less-p (s1 s2)
6025 "Non-nil means type of file S1 is less than that of S2, or S1 < S2 (alpha).
6026 A directory has a lower file type than a non-directory.
6027 The type of a non-directory is its extension. Extensions are compared
6029 If not doing file-name completion, then this is the same as
6030 `icicle-case-string-less-p'."
6031 (if (icicle-file-name-input-p)
6032 (let ((s1-dir-p (icicle-file-directory-p s1))
6033 (s2-dir-p (icicle-file-directory-p s2)))
6034 (cond ((and s1-dir-p s2-dir-p) (icicle-case-string-less-p s1 s2)) ; Both are dirs, so alpha.
6035 ((not (or s1-dir-p s2-dir-p)) ; Neither is a dir. Compare extensions.
6036 (let ((es1 (file-name-extension s1 t))
6037 (es2 (file-name-extension s2 t)))
6038 (if (string= es1 es2) ; If extensions the same, then compare file names.
6039 (icicle-case-string-less-p s1 s2)
6040 (icicle-case-string-less-p es1 es2))))
6041 (s1-dir-p))) ; Directories come before files.
6042 (icicle-case-string-less-p s1 s2)))
6045 (put 'icicle-dirs-first-p 'icicle-file-name-sort-predicate t)
6046 ;; This predicate is used for file-name completion.
6047 (defun icicle-dirs-first-p (s1 s2)
6048 "Non-nil means S1 is a dir and S2 a file, or S1 < S2 (alphabet).
6049 If not doing file-name completion, then this is the same as
6050 `icicle-case-string-less-p'."
6051 (if (icicle-file-name-input-p)
6052 (let ((s1-dir-p (icicle-file-directory-p s1))
6053 (s2-dir-p (icicle-file-directory-p s2)))
6054 (if (or (and s1-dir-p s2-dir-p) ; Both or neither are directories.
6055 (not (or s1-dir-p s2-dir-p)))
6056 (icicle-case-string-less-p s1 s2) ; Compare equals.
6057 s1-dir-p)) ; Directories come before files.
6058 (icicle-case-string-less-p s1 s2)))
6061 (put 'icicle-dirs-last-p 'icicle-file-name-sort-predicate t)
6062 ;; This predicate is used for file-name completion.
6063 (defun icicle-dirs-last-p (s1 s2)
6064 "Non-nil means S1 is a file and S2 a dir, or S1 < S2 (alphabet).
6065 This is especially useful when `icicle-cycle-into-subdirs-flag' is
6066 non-nil. Otherwise, cycling into subdirectories is depth-first, not
6068 If not doing file-name completion, then this is the same as
6069 `icicle-case-string-less-p'."
6070 (if (icicle-file-name-input-p)
6071 (let ((s1-dir-p (icicle-file-directory-p s1))
6072 (s2-dir-p (icicle-file-directory-p s2)))
6073 (if (or (and s1-dir-p s2-dir-p) ; Both or neither are directories.
6074 (not (or s1-dir-p s2-dir-p)))
6075 (icicle-case-string-less-p s1 s2) ; Compare equals.
6076 s2-dir-p)) ; Files come before directories.
6077 (icicle-case-string-less-p s1 s2)))
6080 (put 'icicle-2nd-part-string-less-p 'icicle-multi-completion-sort-predicate t)
6081 ;; This predicate is used for multi-completion.
6082 (defun icicle-2nd-part-string-less-p (s1 s2)
6083 "`icicle-case-string-less-p' for second parts, then for first parts.
6084 S1 and S2 are multi-completion strings.
6085 Returns non-nil if either of these is true:
6087 * The second parts of S1 and S2 are the equivalent and the first part
6088 of S1 comes before the first part of S2, alphabetically.
6090 * The second part of S1 comes before the second part of S2,
6093 Alphabetical comparison is done using `icicle-case-string-less-p'."
6094 (let* ((icicle-list-use-nth-parts '(2))
6095 (s1-2nd (icicle-transform-multi-completion s1))
6096 (s2-2nd (icicle-transform-multi-completion s2)))
6097 (or (icicle-case-string-less-p s1-2nd s2-2nd)
6098 (and (string= s1-2nd s2-2nd)
6099 (let* ((icicle-list-use-nth-parts '(1))
6100 (s1-1st (icicle-transform-multi-completion s1))
6101 (s2-1st (icicle-transform-multi-completion s2))))))))
6104 (put 'icicle-last-modified-first-p 'icicle-file-name-sort-predicate t)
6105 ;; This predicate is used for file-name completion.
6106 (defun icicle-last-modified-first-p (s1 s2)
6107 "Non-nil means file S1 was last modified after S2.
6108 If not doing file-name completion, then this is the same as
6109 `icicle-case-string-less-p'."
6110 (if (icicle-file-name-input-p)
6111 (let ((mod-date1 (nth 5 (file-attributes s1)))
6112 (mod-date2 (nth 5 (file-attributes s2))))
6113 (or (< (car mod-date2) (car mod-date1)) ; High-order bits.
6114 (and (= (car mod-date2) (car mod-date1)) ; Low-order bits.
6115 (< (cadr mod-date2) (cadr mod-date1)))))
6116 (icicle-case-string-less-p s1 s2)))
6119 (put 'icicle-command-abbrev-used-more-p 'icicle-command-sort-predicate t)
6120 ;; This predicate is used for command and abbreviation completion.
6121 (defun icicle-command-abbrev-used-more-p (s1 s2)
6122 "Return non-nil if S1 was invoked more often than S2 via an abbrev.
6123 S1 and S2 are strings naming commands.
6124 If neither was invoked or both were invoked the same number of times,
6125 then return non-nil if S1 is `string-lessp' S2."
6126 (let* ((alist-tails (mapcar #'cdr icicle-command-abbrev-alist))
6127 (s1-entry (assq (intern s1) alist-tails))
6128 (s2-entry (assq (intern s2) alist-tails)))
6129 (if (and (not s1-entry) (not s2-entry))
6130 (string-lessp s1 s2)
6131 (let ((s1-rank (elt s1-entry 1))
6132 (s2-rank (elt s2-entry 1)))
6133 (cond ((and (not s1-rank) (not s2-rank)) (string-lessp s1 s2))
6134 ((and s1-rank s2-rank (eq s1-rank s2-rank)) (string-lessp s1 s2))
6135 (t (>= (or s1-rank 0) (or s2-rank 0))))))))
6137 (defun icicle-part-N-lessp (n s1 s2)
6138 "`icicle-case-string-less-p' applied to the Nth parts of S1 and S2.
6139 The strings each have at least N parts, separated by
6140 `icicle-list-join-string'. Parts other than the Nth are ignored.
6141 Return non-nil if and only if the Nth part of S1 is less than the Nth
6142 part of S2. The Nth parts are compared lexicographically without
6143 regard to letter case. N is one-based, so a value of 1 means compare
6145 (unless (and (wholenump n) (> n 0)) (error "`icicle-part-N-lessp': N must be > 0"))
6146 (let ((case-fold-search t)
6147 (part-N-s1 (elt (split-string s1 icicle-list-join-string) (1- n)))
6148 (part-N-s2 (elt (split-string s2 icicle-list-join-string) (1- n))))
6149 (and part-N-s1 part-N-s2 ; In case strings were not multipart.
6150 (icicle-case-string-less-p part-N-s1 part-N-s2))))
6152 (defun icicle-part-1-lessp (s1 s2)
6153 "`icicle-part-N-lessp', with N = 1."
6154 (icicle-part-N-lessp 1 s1 s2))
6156 (defun icicle-part-2-lessp (s1 s2)
6157 "`icicle-part-N-lessp', with N = 2."
6158 (icicle-part-N-lessp 2 s1 s2))
6160 (defun icicle-part-3-lessp (s1 s2)
6161 "`icicle-part-N-lessp', with N = 3."
6162 (icicle-part-N-lessp 3 s1 s2))
6164 (defun icicle-part-4-lessp (s1 s2)
6165 "`icicle-part-N-lessp', with N = 4."
6166 (icicle-part-N-lessp 4 s1 s2))
6168 (defun icicle-cdr-lessp (s1 s2)
6169 "Non-nil means the cdr of S1's entry < the cdr of S2's entry.
6170 Entry here means the complete alist element candidate that corresponds
6171 to the displayed candidate (string) S1 or S2.
6172 Returns nil if comparing the cdrs using `<' would raise an error."
6174 (< (cdr (funcall icicle-get-alist-candidate-function s1))
6175 (cdr (funcall icicle-get-alist-candidate-function s2)))
6178 (defun icicle-part-1-cdr-lessp (s1 s2)
6179 "First part and cdr of S1 are less than those of S2."
6180 (or (icicle-part-1-lessp s1 s2)
6181 (and (not (icicle-part-1-lessp s2 s1)) (icicle-cdr-lessp s1 s2))))
6184 ;; This predicate is used for color completion.
6185 (defun icicle-color-rgb-lessp (s1 s2)
6186 "Non-nil means the RGB components of S1 are less than those of S2.
6187 Specifically, the red components are compared first, then if they are
6188 equal the blue components are compared, then if those are also equal
6189 the green components are compared.
6191 The strings are assumed to have at least two parts, with the parts
6192 separated by `icicle-list-join-string' The second parts of the strings
6193 are RGB triplets that start with `#'."
6194 (icicle-part-2-lessp s1 s2)) ; Just compare lexicographically.
6196 ;; This predicate is used for key completion.
6197 (defun icicle-prefix-keys-first-p (s1 s2)
6198 "Non-nil if S1 is a prefix key and S2 is not or S1 < S2 (alphabet).
6199 For this function, a prefix key is represented by a string that ends
6202 When used as a comparison function for completion candidates, this
6203 makes prefix keys that match your input available first (at the top of
6204 buffer `*Completions*'). Candidates are effectively in two groups,
6205 each of which is sorted alphabetically separately: prefix keys,
6206 followed by non-prefix keys. Letter case is ignored.
6208 The special key representation \"..\" is, however, less than all other
6209 keys, including prefix keys."
6210 (let* ((prefix-string " = \\.\\.\\.$")
6211 (parent-string "..")
6212 (s1-prefix-p (save-match-data (string-match prefix-string s1)))
6213 (s2-prefix-p (save-match-data (string-match prefix-string s2)))
6214 (completion-ignore-case t))
6215 (and (not (string= parent-string s2))
6216 (or (string= parent-string s1)
6217 (and (not s1-prefix-p) (not s2-prefix-p) (icicle-case-string-less-p s1 s2))
6218 (and s1-prefix-p (not s2-prefix-p))
6219 (and s1-prefix-p s2-prefix-p (icicle-case-string-less-p s1 s2))))))
6221 ;; This predicate is used for key completion.
6222 (defun icicle-local-keys-first-p (s1 s2)
6223 "Non-nil if S1 is a local key and S2 is not or S1 < S2 (alphabet).
6224 For this function, a local key is highlighted as a special candidate.
6226 When used as a comparison function for completion candidates, this
6227 makes local keys that match your input available first (at the top of
6228 buffer `*Completions*'). Candidates are effectively in two groups,
6229 each of which is sorted alphabetically separately: local keys,
6230 followed by non-prefix keys. Letter case is ignored.
6232 The special key representation \"..\" is, however, less than all other
6233 keys, including local keys."
6234 (or (string= ".." s1)
6235 (and (not (string= ".." s2)) (icicle-special-candidates-first-p s1 s2))))
6237 ;; This predicate is used for key completion.
6238 (defun icicle-command-names-alphabetic-p (s1 s2)
6239 "Non-nil if command name of S1 `icicle-case-string-less-p' that of S2.
6240 When used as a comparison function for completion candidates, this
6241 assumes that each candidate, S1 and S2, is composed of a key name
6242 followed by \" = \", followed by the corresponding command name."
6243 (let ((icicle-list-join-string " = ")) ; Fake a multi-completion. Candidate is key = cmd.
6244 (icicle-part-2-lessp s1 s2)))
6246 (defun icicle-special-candidates-first-p (s1 s2)
6247 "Non-nil if S1 is special candidate and S2 is not or S1<S2 (alphabet).
6248 That is, S1 < S2 if S1 is a special candidate and S2 is not or S1
6249 `icicle-case-string-less-p' S2 and either both or neither are special
6251 (let ((s1-special (get (intern s1) 'icicle-special-candidate))
6252 (s2-special (get (intern s2) 'icicle-special-candidate)))
6253 (when (or case-fold-search completion-ignore-case
6254 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
6255 (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
6256 (boundp 'read-file-name-completion-ignore-case)
6257 read-file-name-completion-ignore-case))
6258 (setq s1 (icicle-upcase s1)
6259 s2 (icicle-upcase s2)))
6260 (or (and s1-special (not s2-special))
6261 (and s1-special s2-special (icicle-case-string-less-p s1 s2))
6262 (and (not s1-special) (not s2-special) (icicle-case-string-less-p s1 s2)))))
6264 (defun icicle-extra-candidates-first-p (s1 s2)
6265 "Non-nil if S1 is an extra candidate and S2 is not or S1<S2 (alphabet).
6266 That is, S1 < S2 if S1 is an extra candidate and S2 is not or S1
6267 `icicle-case-string-less-p' S2 and either both or neither are extra
6268 candidates. An extra candidate is one that is a member of
6269 `icicle-extra-candidates'."
6270 (let ((s1-extra (member s1 icicle-extra-candidates))
6271 (s2-extra (member s2 icicle-extra-candidates)))
6272 (when (or case-fold-search completion-ignore-case
6273 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
6274 (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
6275 (boundp 'read-file-name-completion-ignore-case)
6276 read-file-name-completion-ignore-case))
6277 (setq s1 (icicle-upcase s1)
6278 s2 (icicle-upcase s2)))
6279 (or (and s1-extra (not s2-extra))
6280 (and s1-extra s2-extra (icicle-case-string-less-p s1 s2))
6281 (and (not s1-extra) (not s2-extra) (icicle-case-string-less-p s1 s2)))))
6283 (put 'icicle-proxy-candidate-first-p 'icicle-proxy-sort-predicate t)
6284 ;; This predicate is used when there are proxy candidates.
6285 (defun icicle-proxy-candidate-first-p (s1 s2)
6286 "Return non-nil if S1 is a proxy candidate and S2 is not.
6287 Return nil if S2 is a proxy candidate and S1 is not.
6288 Otherwise, return non-nil if S1 is `string-lessp' S2."
6289 (let ((s1-proxy-p (or (member s1 icicle-proxy-candidates)
6290 (and icicle-proxy-candidate-regexp
6291 (save-match-data (string-match icicle-proxy-candidate-regexp s1)))))
6292 (s2-proxy-p (or (member s2 icicle-proxy-candidates)
6293 (and icicle-proxy-candidate-regexp
6294 (save-match-data (string-match icicle-proxy-candidate-regexp s2))))))
6295 (or (and (not s1-proxy-p) (not s2-proxy-p) (icicle-case-string-less-p s1 s2))
6296 (and s1-proxy-p (not s2-proxy-p))
6297 (and s1-proxy-p s2-proxy-p (icicle-case-string-less-p s1 s2)))))
6300 (defun icicle-case-insensitive-string-less-p (string1 string2)
6301 "Like `string-lessp', but case is ignored, so `A' = `a' , and so on."
6302 (string-lessp (icicle-upcase string1) (icicle-upcase string2)))
6304 (defun icicle-case-string-less-p (s1 s2)
6305 "Like `string-lessp', but respects `completion-ignore-case'."
6306 (when (if icicle-completing-p ; Use var, not fn, `icicle-completing-p', or else too slow.
6307 ;; Don't bother with buffer completion and `read-buffer-completion-ignore-case'.
6308 (if (and (or (icicle-file-name-input-p) icicle-abs-file-candidates)
6309 (boundp 'read-file-name-completion-ignore-case))
6310 read-file-name-completion-ignore-case
6311 completion-ignore-case)
6313 (setq s1 (icicle-upcase s1)
6314 s2 (icicle-upcase s2)))
6315 ;; (when completion-ignore-case ; Alternative.
6316 ;; (setq s1 (icicle-upcase s1) s2 (icicle-upcase s2)))
6317 (string-lessp s1 s2))
6319 (defun icicle-upcase (string)
6320 "`upcase', but in case of error, return original STRING.
6321 This works around an Emacs 20 problem that occurs if STRING contains
6322 binary data (weird chars)."
6323 ;; E.g. Emacs 20 for plist of `dired-revert' put through (format "%s").
6324 (condition-case nil (upcase string) (error string)))
6326 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6328 (provide 'icicles-fn)
6330 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6331 ;;; icicles-fn.el ends here
projects / emacs-init.git / blob