icicle update
[emacs.git] / .emacs.d / elisp / icicle / icicles-fn.el
1 ;;; icicles-fn.el --- Non-interactive functions for Icicles
2 ;;
3 ;; Filename: icicles-fn.el
4 ;; Description: Non-interactive functions for Icicles
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
7 ;; Copyright (C) 1996-2014, Drew Adams, all rights reserved.
8 ;; Created: Mon Feb 27 09:25:53 2006
9 ;; Last-Updated: Tue Apr 29 18:03:41 2014 (-0700)
10 ;; By: dradams
11 ;; Update #: 14628
12 ;; URL: http://www.emacswiki.org/icicles-fn.el
13 ;; Doc URL: http://www.emacswiki.org/Icicles
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, 24.x
17 ;;
18 ;; Features that might be required by this library:
19 ;;
20 ;; `apropos', `apropos-fn+var', `cl', `cus-theme',
21 ;; `el-swank-fuzzy', `ffap', `ffap-', `fuzzy', `fuzzy-match',
22 ;; `hexrgb', `icicles-opt', `icicles-var', `kmacro', `levenshtein',
23 ;; `naked', `regexp-opt', `thingatpt', `thingatpt+', `wid-edit',
24 ;; `wid-edit+', `widget'.
25 ;;
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
27 ;;
28 ;;; Commentary:
29 ;;
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'.
33 ;;
34 ;; Macros defined here:
35 ;;
36 ;; `icicle-maybe-cached-action', `minibuffer-with-setup-hook'.
37 ;;
38 ;; Commands defined here:
39 ;;
40 ;; `icicle-dired-smart-shell-command',
41 ;; `icicle-minibuffer-default-add-dired-shell-commands',
42 ;; `icicle-shell-command', `icicle-shell-command-on-region',
43 ;;
44 ;; Non-interactive functions defined here:
45 ;;
46 ;; `assq-delete-all', `icicle-2nd-part-string-less-p',
47 ;; `icicle-abbreviate-or-expand-file-name',
48 ;; `icicle-all-completions', `icicle-alpha-p',
49 ;; `icicle-alt-act-fn-for-type', `icicle-any-candidates-p',
50 ;; `icicle-apropos-any-candidates-p',
51 ;; `icicle-apropos-any-file-name-candidates-p',
52 ;; `icicle-apropos-candidates', `icicle-assoc-delete-all',
53 ;; `icicle-barf-if-outside-Completions',
54 ;; `icicle-barf-if-outside-Completions-and-minibuffer',
55 ;; `icicle-barf-if-outside-minibuffer',
56 ;; `icicle-bounds-of-thing-at-point',
57 ;; `icicle-buffer-file/process-name-less-p',
58 ;; `icicle-buffer-smaller-p',
59 ;; `icicle-call-then-update-Completions', `icicle-candidate-set-1',
60 ;; `icicle-candidate-short-help',
61 ;; `icicle-case-insensitive-string-less-p',
62 ;; `icicle-case-string-less-p', `icicle-cdr-lessp',
63 ;; `icicle-char-cands-from-charlist',
64 ;; `icicle-choose-completion-string', `icicle-clear-lighter',
65 ;; `icicle-clear-minibuffer', `icicle-color-name-w-bg',
66 ;; `icicle-color-rgb-lessp', `icicle-command-abbrev-save',
67 ;; `icicle-command-abbrev-used-more-p',
68 ;; `icicle-command-names-alphabetic-p',
69 ;; `icicle-complete-again-update', `icicle-completing-p',
70 ;; `icicle-completing-read', `icicle-completing-read-multiple',
71 ;; `icicle-completing-read-history',
72 ;; `icicle-completion-all-completions',
73 ;; `icicle-completion-setup-function',
74 ;; `icicle-completion--embedded-envvar-table',
75 ;; `icicle-completion-try-completion', `icicle-create-thumb',
76 ;; `icicle-current-TAB-method', `icicle-custom-type',
77 ;; `icicle-defaults-at-point', `icicle-define-crm-completion-map',
78 ;; `icicle-delete-alist-dups', `icicle-delete-count',
79 ;; `icicle-delete-dups', `icicle-delete-whitespace-from-string',
80 ;; `icicle-dired-read-shell-command',
81 ;; `icicle-dir-prefix-wo-wildcards',
82 ;; `icicle-dirs-and-latest-use-first-p', `icicle-dirs-first-p',
83 ;; `icicle-dirs-last-p', `icicle-displayable-cand-from-saved-set',
84 ;; `icicle-display-cand-from-full-cand',
85 ;; `icicle-display-completion-list', `icicle-display-Completions',
86 ;; `icicle-display-candidates-in-Completions',
87 ;; `icicle-expanded-common-match',
88 ;; `icicle-expanded-common-match-1', `icicle-expand-file-name-20',
89 ;; `icicle-expand-file-or-dir-name',
90 ;; `icicle-explicit-saved-completion-candidates',
91 ;; `icicle-extra-candidates-first-p',
92 ;; `icicle-face-valid-attribute-values',
93 ;; `icicle-file-name-apropos-candidates',
94 ;; `icicle-file-name-directory',
95 ;; `icicle-file-name-directory-w-default',
96 ;; `icicle-file-name-input-p', `icicle-file-name-nondirectory',
97 ;; `icicle-file-name-prefix-candidates', `icicle-file-readable-p',
98 ;; `icicle-file-remote-p', `icicle-file-type-less-p',
99 ;; `icicle-file-writable-p', `icicle-filesets-files-under',
100 ;; `icicle-files-within', `icicle-files-within-1',
101 ;; `icicle-filter-alist', `icicle-filter-wo-input',
102 ;; `icicle-find-tag-default-as-regexp',
103 ;; `icicle-first-matching-candidate', `icicle-first-N',
104 ;; `icicle-fit-completions-window', `icicle-fix-default-directory',
105 ;; `icicle-flat-list', `icicle-frames-on',
106 ;; `icicle-fuzzy-candidates', `icicle-get-alist-candidate',
107 ;; `icicle-get-candidates-from-saved-set', `icicle-get-safe',
108 ;; `icicle-dired-guess-shell-command',
109 ;; `icicle-handle-default-for-prompt', `icicle-help-line-buffer',
110 ;; `icicle-help-line-file',
111 ;; `icicle-highlight-candidate-in-Completions',
112 ;; `icicle-highlight-complete-input',
113 ;; `icicle-highlight-initial-whitespace',
114 ;; `icicle-highlight-input-noncompletion',
115 ;; `icicle-highlight-input-noncompletion-rest',
116 ;; `icicle-highlight-lighter', `icicle-historical-alphabetic-p',
117 ;; `icicle-increment-cand-nb+signal-end',
118 ;; `icicle-Info-node-is-indexed-by-topic',
119 ;; `icicle-input-from-minibuffer', `icicle-insert-candidates',
120 ;; `icicle-insert-cand-in-minibuffer',
121 ;; `icicle-insert-Completions-help-string',
122 ;; `icicle-join-nth-parts', `icicle-key-description',
123 ;; `icicle-kill-a-buffer', `icicle-latest-access-first-p',
124 ;; `icicle-latest-input-first-p',
125 ;; `icicle-latest-modification-first-p',
126 ;; `icicle-latest-use-first-p', `icicle-levenshtein-match',
127 ;; `icicle-levenshtein-one-match', `icicle-levenshtein-one-regexp',
128 ;; `icicle-levenshtein-strict-match',
129 ;; `icicle-lisp-vanilla-completing-read', `icicle-list-position',
130 ;; `icicle-looks-like-dir-name-p', `icicle-local-keys-first-p',
131 ;; `icicle-make-char-candidate', `icicle-make-face-candidate',
132 ;; `icicle-make-plain-predicate', `icicle-major-mode-name-less-p',
133 ;; `icicle-maybe-sort-and-strip-candidates',
134 ;; `icicle-maybe-sort-maybe-truncate', `icicle-mctize-all',
135 ;; `icicle-mctized-display-candidate',
136 ;; `icicle-mctized-full-candidate', `icicle-member-ignore-case',
137 ;; `icicle-merge-saved-order-less-p',
138 ;; `icicle-minibuffer-default-add-completions',
139 ;; `icicle-minibuf-input', `icicle-minibuf-input-sans-dir',
140 ;; `icicle-minibuffer-prompt-end', `icicle-mode-line-name-less-p',
141 ;; `icicle-mouseover-help', `icicle-msg-maybe-in-minibuffer',
142 ;; `icicle-ms-windows-NET-USE',
143 ;; `icicle-multi-comp-apropos-complete-match', `icicle-multi-sort',
144 ;; `icicle-next-candidate', `icicle-not-basic-prefix-completion-p',
145 ;; `icicle-ORIG-choose-completion-string',
146 ;; `icicle-ORIG-completing-read',
147 ;; `icicle-ORIG-completing-read-multiple',
148 ;; `icicle-ORIG-completion-setup-function',
149 ;; `icicle-ORIG-dired-smart-shell-command',
150 ;; `icicle-ORIG-display-completion-list',
151 ;; `icicle-ORIG-face-valid-attribute-values',
152 ;; `icicle-ORIG-minibuffer-default-add-completions',
153 ;; `icicle-ORIG-read-buffer', `icicle-ORIG-read-char-by-name',
154 ;; `icicle-ORIG-read-face-name',
155 ;; `icicle-ORIG-read-from-minibuffer', `icicle-ORIG-read-number',
156 ;; `icicle-ORIG-read-string', `icicle-ORIG-shell-command',
157 ;; `icicle-ORIG-shell-command-on-region',
158 ;; `icicle-part-1-cdr-lessp', `icicle-part-1-lessp',
159 ;; `icicle-part-2-lessp', `icicle-part-3-lessp',
160 ;; `icicle-part-4-lessp', `icicle-part-N-lessp',
161 ;; `icicle-place-cursor', `icicle-place-overlay',
162 ;; `icicle-position', `icicle-prefix-any-candidates-p',
163 ;; `icicle-prefix-any-file-name-candidates-p',
164 ;; `icicle-prefix-candidates', `icicle-prefix-keys-first-p',
165 ;; `icicle-propertize', `icicle-proxy-candidate-first-p',
166 ;; `icicle-put-at-head', `icicle-put-whole-cand-prop',
167 ;; `icicle-quote-file-name-part-of-cmd',
168 ;; `icicle-readable-to-markers', `icicle-read-buffer',
169 ;; `icicle-read-char-by-name', `icicle-read-char-exclusive',
170 ;; `icicle-read-char-maybe-completing', `icicle-read-face-name',
171 ;; `icicle-read-file-name', `icicle-read-file-name-default',
172 ;; `icicle-read-from-minibuffer',
173 ;; `icicle-read-from-minibuf-nil-default', `icicle-read-number',
174 ;; `icicle-read-regexp', `icicle-read-shell-command',
175 ;; `icicle-read-shell-command-completing', `icicle-read-string',
176 ;; `icicle-read-string-completing', `icicle-repeat-command',
177 ;; `icicle-recentf-make-menu-items', `icicle-recompute-candidates',
178 ;; `icicle-remove-color-duplicates', `icicle-remove-dots',
179 ;; `icicle-remove-duplicates', `icicle-remove-dups-if-extras',
180 ;; `icicle-remove-if', `icicle-remove-if-not',
181 ;; `icicle-remove-property', `icicle-replace-mct-cand-in-mct',
182 ;; `icicle-require-match-p', `icicle-restore-standard-commands',
183 ;; `icicle-restore-standard-options',
184 ;; `icicle-restore-std-completion-fns', `icicle-reversible-sort',
185 ;; `icicle-saved-fileset-p', `icicle-save-or-restore-input',
186 ;; `icicle-save-raw-input', `icicle-scatter',
187 ;; `icicle-scatter-match', `icicle-scroll-or-update-Completions',
188 ;; `icicle-set-difference', `icicle-set-intersection',
189 ;; `icicle-set-union', `icicle-show-help-in-mode-line',
190 ;; `icicle-show-in-mode-line', `icicle-some',
191 ;; `icicle-special-candidates-first-p',
192 ;; `icicle-start-of-candidates-in-Completions',
193 ;; `icicle-string-match-p', `icicle-strip-ignored-files-and-sort',
194 ;; `icicle-subst-envvar-in-file-name',
195 ;; `icicle-substring-no-properties', `icicle-substrings-of-length',
196 ;; `icicle-take', `icicle-toggle-icicle-mode-twice',
197 ;; `icicle-transform-candidates',
198 ;; `icicle-transform-multi-completion', `icicle-try-switch-buffer',
199 ;; `icicle-ucs-names', `icicle-unhighlight-lighter',
200 ;; `icicle-unlist', `icicle-unpropertize-completion',
201 ;; `icicle-unsorted-apropos-candidates',
202 ;; `icicle-unsorted-file-name-apropos-candidates',
203 ;; `icicle-unsorted-file-name-prefix-candidates',
204 ;; `icicle-unsorted-prefix-candidates', `icicle-upcase',
205 ;; `icicle-value-satisfies-type-p', `icicle-var-inherits-type-p',
206 ;; `icicle-var-is-of-type-p', `icicle-var-matches-type-p',
207 ;; `icicle-var-val-satisfies-type-p',
208 ;; `select-frame-set-input-focus'.
209 ;;
210 ;; Internal variables defined here:
211 ;;
212 ;; `icicle-crm-local-completion-map',
213 ;; `icicle-crm-local-must-match-map', `icicle-dirs-done',
214 ;; `icicle-files', `icicle-ORIG-crm-local-completion-map',
215 ;; `icicle-ORIG-crm-local-must-match-map'.
216 ;;
217 ;;
218 ;; ***** NOTE: This vanilla Emacs function is defined here for
219 ;; Emacs 20, where it does not exist.
220 ;;
221 ;; `replace-regexp-in-string' (Emacs 20).
222 ;;
223 ;;
224 ;; ***** NOTE: These EMACS PRIMITIVES have been REDEFINED HERE:
225 ;;
226 ;; `completing-read' - (See doc string.)
227 ;; `display-completion-list' - (See doc string.)
228 ;; `face-valid-attribute-values' - (See doc string.)
229 ;; `read-file-name' Emacs 20, 21 only - (See doc string.)
230 ;; `read-from-minibuffer' - (See doc string.)
231 ;; `read-string' - (See doc string.)
232 ;;
233 ;;
234 ;; ***** NOTE: The following functions defined in `simple.el' have
235 ;; been REDEFINED HERE:
236 ;;
237 ;; `choose-completion-string' -
238 ;; Don't exit minibuffer after `lisp-complete-symbol' completion.
239 ;; `completion-setup-function' - 1. Put faces on inserted string(s).
240 ;; 2. Help on help.
241 ;; `repeat-complex-command' - Use `completing-read' to read command.
242 ;;
243 ;;
244 ;; ***** NOTE: The following function defined in `filesets.el' has
245 ;; been REDEFINED HERE:
246 ;;
247 ;; `filesets-get-filelist' - Fix. Bug #976 reported to Emacs devel.
248 ;;
249 ;; For descriptions of changes to this file, see `icicles-chg.el'.
250
251 ;;(@> "Index")
252 ;;
253 ;; If you have library `linkd.el' and Emacs 22 or later, load
254 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
255 ;; navigate around the sections of this doc. Linkd mode will
256 ;; highlight this Index, as well as the cross-references and section
257 ;; headings throughout this file. You can get `linkd.el' here:
258 ;; http://dto.freeshell.org/notebook/Linkd.html.
259 ;;
260 ;; (@> "Macros")
261 ;; (@> "Redefined standard functions")
262 ;; (@> "Icicles functions - completion display (not cycling)")
263 ;; (@> "Icicles functions - TAB completion cycling")
264 ;; (@> "Icicles functions - S-TAB completion cycling")
265 ;; (@> "Icicles functions - common helper functions")
266 ;; (@> "Icicles functions - sort functions")
267
268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
269 ;;
270 ;; This program is free software; you can redistribute it and/or
271 ;; modify it under the terms of the GNU General Public License as
272 ;; published by the Free Software Foundation; either version 2, or (at
273 ;; your option) any later version.
274 ;;
275 ;; This program is distributed in the hope that it will be useful, but
276 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
277 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
278 ;; General Public License for more details.
279 ;;
280 ;; You should have received a copy of the GNU General Public License
281 ;; along with this program; see the file COPYING. If not, write to
282 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
283 ;; Floor, Boston, MA 02110-1301, USA.
284 ;;
285 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
286 ;;
287 ;;; Code:
288
289 (eval-when-compile (require 'cl)) ;; case, lexical-let, loop
290
291 (require 'hexrgb nil t) ;; (no error if not found): hexrgb-color-name-to-hex
292 (require 'wid-edit+ nil t) ;; (no error if not found):
293 ;; redefined color widget (for icicle-var-is-of-type-p)
294
295 (eval-when-compile
296 (or (condition-case nil
297 (load-library "icicles-mac") ; Use load-library to ensure latest .elc.
298 (error nil))
299 (require 'icicles-mac))) ; Require, so can load separately if not on `load-path'.
300 ;; icicle-with-selected-window
301
302 (require 'icicles-opt) ; (This is required anyway by `icicles-var.el'.)
303 ;; icicle-add-proxy-candidates-flag, icicle-buffer-ignore-space-prefix-flag,
304 ;; icicle-Completions-display-min-input-chars, icicle-current-TAB-method, icicle-expand-input-to-common-match,
305 ;; icicle-hide-common-match-in-Completions-flag, icicle-hide-non-matching-lines-flag,
306 ;; icicle-highlight-historical-candidates-flag, icicle-highlight-input-initial-whitespace-flag,
307 ;; icicle-incremental-completion-delay, icicle-incremental-completion, icicle-incremental-completion-threshold,
308 ;; icicle-default-value, icicle-list-join-string, icicle-mark-position-in-candidate,
309 ;; icicle-point-position-in-candidate, icicle-regexp-quote-flag, icicle-require-match-flag,
310 ;; icicle-shell-command-candidates-cache, icicle-show-Completions-help-flag, icicle-sort-comparer,
311 ;; icicle-sort-orders-alist, icicle-special-candidate-regexp, icicle-transform-function,
312 ;; icicle-use-~-for-home-dir-flag
313
314 (require 'icicles-var)
315 ;; icicle-abs-file-candidates, icicle-all-candidates-action, icicle-apropos-complete-match-fn,
316 ;; icicle-auto-no-icomplete-mode-p, icicle-auto-no-sort-p, icicle-buffer-name-input-p,
317 ;; icicle-candidate-alt-action-fn, icicle-candidate-nb, icicle-candidate-action-fn,
318 ;; icicle-candidate-properties-alist, icicle-candidates-alist, icicle-cmd-calling-for-completion,
319 ;; icicle-common-match-string, icicle-comp-base-is-default-dir-p, icicle-complete-input-overlay,
320 ;; icicle-completing-keys-p, icicle-completing-p (variable), icicle-completion-candidates,
321 ;; icicle-current-completion-mode, icicle-current-input, icicle-current-raw-input, icicle-cycling-p,
322 ;; icicle-dir-candidate-can-exit-p, icicle-edit-update-p, icicle-exclude-default-proxies,
323 ;; icicle-extra-candidates, icicle-extra-candidates-dir-insert-p, icicle-fancy-candidates-p,
324 ;; icicle-fancy-cands-internal-p, icicle-file-name-completion-table, icicle-filtered-default-value,
325 ;; icicle-hist-cands-no-highlight, icicle-ignored-extensions-regexp, icicle-incremental-completion-p,
326 ;; icicle-initial-value, icicle-input-completion-fail-overlay, icicle-input-fail-pos,
327 ;; icicle-last-completion-candidate, icicle-last-icomplete-mode-value, icicle-last-input,
328 ;; icicle-last-sort-comparer, icicle-last-top-level-command, icicle-lighter-truncation,
329 ;; icicle-list-use-nth-parts, icicle-minibuffer-message-ok-p, icicle-mode-line-help,
330 ;; icicle-ms-windows-drive-hash, icicle-multi-completing-p, icicle-must-match-regexp,
331 ;; icicle-must-not-match-regexp, icicle-must-pass-predicate, icicle-must-pass-after-match-predicate,
332 ;; icicle-nb-candidates-before-truncation, icicle-nb-of-other-cycle-candidates,
333 ;; icicle-orig-must-pass-after-match-pred, icicle-orig-read-file-name-fn, icicle-orig-window,
334 ;; icicle-pre-minibuffer-buffer, icicle-previous-raw-file-name-inputs,
335 ;; icicle-previous-raw-non-file-name-inputs, icicle-proxy-candidate-regexp, icicle-proxy-candidates,
336 ;; icicle-read-char-history, icicle-require-match-p, icicle-remove-icicles-props-p, icicle-re-no-dot,
337 ;; icicle-reverse-multi-sort-p, icicle-reverse-sort-p, icicle-saved-candidate-overlays,
338 ;; icicle-saved-completion-candidate, icicle-saved-completion-candidates, icicle-transform-before-sort-p,
339 ;; icicle-whole-candidate-as-text-prop-p, lacarte-menu-items-alist
340
341 ;; This requirement is real, but leads to recursion.
342 ;; You should, in any case, just load everything by loading `icicles.el'.
343 ;; (require 'icicles-mode) ;; icicle-mode
344
345
346 ;; Byte-compiling this file, you will likely get some error or warning
347 ;; messages due to differences between different versions of Emacs.
348
349
350 ;;; Defvars to quiet the byte-compiler:
351
352 (when (< emacs-major-version 22)
353 (defvar completion-annotate-function)
354 (defvar completion-common-substring)
355 (defvar completion-extra-properties)
356 (defvar completion-root-regexp)
357 (defvar icicle-Info-visited-max-candidates) ; In `icicles-opt.el' (for Emacs 22+)
358 (defvar minibuffer-completing-symbol)
359 (defvar minibuffer-prompt-properties)
360 (defvar partial-completion-mode)
361 (defvar read-file-name-completion-ignore-case)
362 (defvar minibuffer-local-filename-completion-map)
363 (defvar minibuffer-local-must-match-filename-map)
364 (defvar minibuffer-local-filename-must-match-map)
365 (defvar read-file-name-predicate)
366 (defvar tooltip-mode))
367
368 (when (< emacs-major-version 23)
369 (defvar completion--embedded-envvar-re) ; In `minibuffer.el'.
370 (defvar completion-styles) ; In `minibuffer.el'
371 (defvar icicle-Completions-text-scale-decrease)) ; In `icicles-opt.el' (for Emacs 23)
372
373 (defvar last-repeatable-command) ; Defined in `repeat.el'.
374 (defvar completion-root-regexp) ; In `simple.el' (for Emacs 22 and 23.1)
375 (defvar crm-local-completion-map) ; In `crm.el'
376 (defvar crm-local-must-match-map) ; In `crm.el'
377 (defvar crm-separator) ; In `crm.el'
378 (defvar doremi-boost-down-keys) ; In `doremi.el'
379 (defvar doremi-boost-up-keys) ; In `doremi.el'
380 (defvar doremi-down-keys) ; In `doremi.el'
381 (defvar doremi-up-keys) ; In `doremi.el'
382 (defvar eyedrop-picked-background) ; In `eyedrop.el' and `palette.el'
383 (defvar eyedrop-picked-foreground) ; In `eyedrop.el' and `palette.el'
384 (defvar filesets-data) ; In `filesets.el'
385 (defvar font-width-table) ; In C code.
386 (defvar font-weight-table) ; In C code.
387 (defvar font-slant-table) ; In C code.
388 (defvar history-delete-duplicates) ; In C code for Emacs 22+.
389 (defvar icicle-file-name-completion-table) ; In `icicles-var.el' for Emacs 24+.
390 (defvar icicle-Info-hist-list) ; In `icicles-cmd2.el'
391 (defvar icicle-Info-index-nodes) ; In `icicles-cmd2.el'
392 (defvar icicle-Info-manual) ; In `icicles-cmd2.el'
393 (defvar icicle-read-char-history) ; In `icicles-var.el' for Emacs 23+.
394 (defvar image-dired-thumb-height) ; In `image-dired.el'.
395 (defvar image-dired-thumb-width) ; In `image-dired.el'.
396 (defvar list-colors-sort) ; In `facemenu.el'
397 (defvar 1on1-*Completions*-frame-flag) ; In `oneonone.el'
398 (defvar minibuffer-default-in-prompt-regexps) ; In `minibuf-eldef.el'.
399 (defvar minibuffer-local-filename-syntax) ; In `minibuffer.el' for Emacs 24+.
400 (defvar read-buffer-completion-ignore-case) ; Emacs 23+.
401 (defvar recentf-list) ; In `recentf.el'
402 (defvar recentf-menu-filter-commands)
403 (defvar recentf-menu-filter)
404 (defvar recentf-max-menu-items)
405 (defvar recentf-menu-open-all-flag)
406 (defvar recentf-menu-filter-commands)
407 (defvar recentf-menu-items-for-commands)
408 (defvar shell-completion-execonly) ; In `shell.el'
409 (defvar ucs-names) ; In `mule-cmds.el'.
410
411
412
413
414 ;; The name changed during development of Emacs 23. They aliased it for 23.1, but removed it for 23.2.
415 ;; Use the new name and alias the old, but don't declare old obsolete (let Emacs 23 do that.)
416 (when (and (boundp 'minibuffer-local-must-match-filename-map) (fboundp 'defvaralias)) ; Emacs 22
417 (defvar minibuffer-local-filename-must-match-map minibuffer-local-must-match-filename-map
418 "Local keymap for minibuffer input with completion for filenames with exact match.")
419 (defvaralias 'minibuffer-local-must-match-filename-map 'minibuffer-local-filename-must-match-map))
420
421 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
422
423
424
425
426 ;;(@* "Macros")
427
428 ;;; Macros -----------------------------------------------------------
429
430 (defmacro icicle-maybe-cached-action (action)
431 "Evaluate and return ACTION or `icicle-all-candidates-action'.
432 If `icicle-all-candidates-action' is nil, use ACTION.
433 If it is t, then set it to the value of ACTION, so the next call
434 returns the same value."
435 `(if icicle-all-candidates-action
436 (if (eq icicle-all-candidates-action t)
437 (setq icicle-all-candidates-action ,action)
438 icicle-all-candidates-action)
439 ,action))
440
441 ;; Same as vanilla definition. Needed for byte-compiling.
442 (defmacro minibuffer-with-setup-hook (fun &rest body)
443 "Temporarily add FUN to `minibuffer-setup-hook' while executing BODY.
444 BODY should use the minibuffer at most once.
445 Recursive uses of the minibuffer are unaffected (FUN is not
446 called additional times).
447
448 This macro actually adds an auxiliary function that calls FUN,
449 rather than FUN itself, to `minibuffer-setup-hook'."
450 ;; (declare (indent 1) (debug t))
451 (let ((hook (make-symbol "setup-hook")))
452 `(let (,hook)
453 (setq ,hook (lambda ()
454 ;; Clear out this hook so it does not interfere
455 ;; with any recursive minibuffer usage.
456 (remove-hook 'minibuffer-setup-hook ,hook)
457 (funcall ,fun)))
458 (unwind-protect
459 (progn (add-hook 'minibuffer-setup-hook ,hook) ,@body)
460 (remove-hook 'minibuffer-setup-hook ,hook)))))
461
462 ;;(@* "Redefined standard functions")
463
464 ;;; Redefined standard functions -------------------------------------
465
466
467 ;; REPLACE ORIGINAL `choose-completion-string' in `simple.el',
468 ;; saving it for restoration when you toggle `icicle-mode'.
469 ;;
470 ;; Don't exit minibuffer if this is just a `lisp-complete-symbol' completion.
471 ;; Go to point-max before insert choice. Respect `icicle-dir-candidate-can-exit-p'.
472 ;;
473 ;; Free variable `completion-reference-buffer' is defined in `simple.el'.
474 ;;
475 (unless (fboundp 'icicle-ORIG-choose-completion-string)
476 (defalias 'icicle-ORIG-choose-completion-string (symbol-function 'choose-completion-string)))
477
478 (cond ((= emacs-major-version 22)
479 (defun icicle-choose-completion-string (choice &optional buffer base-size)
480 "Switch to BUFFER and insert the completion choice CHOICE.
481 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
482 to keep. If it is nil, we call `choose-completion-delete-max-match'
483 to decide what to delete.
484 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
485 the following is true:
486 - it is reading a file name, CHOICE is a directory, and
487 `icicle-dir-candidate-can-exit-p' is nil
488 - `completion-no-auto-exit' is non-nil
489 - this is just a `lisp-complete-symbol' completion."
490 (let* ((buffer (or buffer completion-reference-buffer))
491 (mini-p (minibufferp buffer)))
492 ;; If BUFFER is a minibuffer, barf unless it's currently active.
493 (if (and mini-p (or (not (active-minibuffer-window))
494 (not (equal buffer (window-buffer (active-minibuffer-window))))))
495 (icicle-user-error "Minibuffer is not active for completion")
496 ;; Set buffer so buffer-local `choose-completion-string-functions' works.
497 (set-buffer buffer)
498 (unless (run-hook-with-args-until-success 'choose-completion-string-functions
499 choice buffer mini-p base-size)
500 ;;; $$$$$$ Removed this because it led to an error in Emacs 24, since base-size is nil there.
501 ;;; Anyway, Icicles doesn't really need or use base-size or `choose-completion-delete-max-match'.
502 ;;; ;; Insert the completion into the buffer where completion was requested.
503 ;;; (if base-size
504 ;;; (delete-region (+ base-size (if mini-p (minibuffer-prompt-end) (point-min)))
505 ;;; (if mini-p (point-max) (point)))
506 ;;; (choose-completion-delete-max-match choice))
507
508 ;; Forget about base-size altogether. Replace the whole input always.
509 (delete-region (+ (or base-size 0) (if mini-p (minibuffer-prompt-end) (point-min)))
510 (if mini-p (point-max) (point)))
511 (when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
512 (insert choice)
513 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
514 ;; Update point in the window that BUFFER is showing in.
515 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
516 ;; If completing for the minibuffer, exit it with this choice,
517 ;; unless this was a `lisp-complete-symbol' completion.
518 (and (not completion-no-auto-exit)
519 (equal buffer (window-buffer (minibuffer-window)))
520 (or minibuffer-completion-table
521 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
522 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
523 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
524 ;; or not reading a file name, or chosen file is not a directory.
525 (if (or icicle-dir-candidate-can-exit-p
526 (not (eq minibuffer-completion-table 'read-file-name-internal))
527 (not (file-directory-p (field-string (point-max)))))
528 (exit-minibuffer)
529 (let ((mini (active-minibuffer-window)))
530 (select-window mini)
531 (when minibuffer-auto-raise (raise-frame (window-frame mini)))))))))))
532
533 ((and (= emacs-major-version 23) (= emacs-minor-version 1)) ; Emacs 23.1
534 (defun icicle-choose-completion-string (choice &optional buffer base-size)
535 "Switch to BUFFER and insert the completion choice CHOICE.
536 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
537 to keep. If it is nil, we call `choose-completion-delete-max-match'
538 to decide what to delete.
539 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
540 the following is true:
541 - it is reading a file name, CHOICE is a directory, and
542 `icicle-dir-candidate-can-exit-p' is nil
543 - `completion-no-auto-exit' is non-nil
544 - this is just a `lisp-complete-symbol' completion."
545 (let* ((buffer (or buffer completion-reference-buffer))
546 (mini-p (minibufferp buffer)))
547 ;; If BUFFER is a minibuffer, barf unless it's currently active.
548 (if (and mini-p (or (not (active-minibuffer-window))
549 (not (equal buffer (window-buffer (active-minibuffer-window))))))
550 (icicle-user-error "Minibuffer is not active for completion")
551 (set-buffer buffer) ; So buffer-local `choose-completion-string-functions' works.
552 (unless (run-hook-with-args-until-success 'choose-completion-string-functions
553 choice buffer mini-p base-size)
554 ;; Insert the completion into the buffer where it was requested.
555 ;; Vanilla Emacs FIXME:
556 ;; - There may not be a field at point, or there may be a field but it is not a
557 ;; "completion field", in which case we have to call `choose-completion-delete-max-match',
558 ;; even if BASE-SIZE is set.
559 ;; - We may need to delete further than (point) to (field-end), depending on the
560 ;; `completion-style', and for that we need extra data `completion-extra-size'.
561 (if base-size
562 (delete-region (+ base-size (field-beginning)) (point))
563 (choose-completion-delete-max-match choice))
564 (insert choice)
565 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
566 ;; Update point in the window that BUFFER is showing in.
567 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
568 ;; If completing for the minibuffer, exit it with this choice,
569 ;; unless this was a `lisp-complete-symbol' completion.
570 (and (not completion-no-auto-exit)
571 (minibufferp buffer)
572 (or minibuffer-completion-table
573 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
574 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
575 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
576 ;; or not reading a file name, or chosen file is not a directory.
577 (if (or icicle-dir-candidate-can-exit-p
578 (not (eq minibuffer-completion-table 'read-file-name-internal))
579 (not (file-directory-p (field-string (point-max)))))
580 (exit-minibuffer)
581 (let ((mini (active-minibuffer-window)))
582 (select-window mini)
583 (when minibuffer-auto-raise (raise-frame (window-frame mini)))))))))))
584
585 ((or (> emacs-major-version 23) ; Emacs 23.2+
586 (and (= emacs-major-version 23) (> emacs-minor-version 1)))
587 (defun icicle-choose-completion-string (choice &optional buffer base-position)
588 "Switch to BUFFER and insert the completion choice CHOICE.
589 BASE-POSITION should be a cons whose car is the position where the
590 choice is inserted. It is ignored if not a cons.
591 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
592 the following is true:
593 - it is reading a file name, CHOICE is a directory, and
594 `icicle-dir-candidate-can-exit-p' is nil
595 - `completion-no-auto-exit' is non-nil
596 - this is just a `lisp-complete-symbol' completion."
597 (unless (consp base-position) ; Older code may pass BASE-SIZE instead of BASE-POSITION. Ignore it.
598 ;; No, do not display this message.
599 ;; (message "Obsolete BASE-SIZE argument passed to `choose-completion-string'")
600 (setq base-position nil))
601 (let* ((buffer (or buffer completion-reference-buffer))
602 (mini-p (minibufferp buffer)))
603 ;; If BUFFER is a minibuffer, barf unless it is currently active.
604 (if (and mini-p (or (not (active-minibuffer-window))
605 (not (equal buffer (window-buffer (active-minibuffer-window))))))
606 (icicle-user-error "Minibuffer is not active for completion")
607 ;; Set buffer so buffer-local `choose-completion-string-functions' works.
608 (set-buffer buffer)
609 (unless (run-hook-with-args-until-success
610 'choose-completion-string-functions
611 ;; 4th arg used to be MINI-P, but it was useless and unused - can just use
612 ;; (minibufferp BUFFER). The last arg used to be BASE-SIZE - keep it to avoid
613 ;; breaking older code.
614 choice buffer base-position nil)
615 ;; Forget about base-size altogether. Replace the whole input always.
616 (delete-region (if mini-p (minibuffer-prompt-end) (point-min))
617 (if mini-p (point-max) (point)))
618 (insert choice)
619 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
620 ;; Update point in the window where BUFFER is showing.
621 (let ((window (get-buffer-window buffer t))) (set-window-point window (point)))
622 ;; If completing for the minibuffer, exit it with this choice,
623 ;; unless this was a `lisp-complete-symbol' completion.
624 (and (not completion-no-auto-exit)
625 (minibufferp buffer)
626 (or minibuffer-completion-table
627 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
628 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
629 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
630 ;; or not reading a file name, or chosen file is not a directory.
631 (let* ((result (buffer-substring (field-beginning) (point)))
632 (bounds (completion-boundaries result minibuffer-completion-table
633 minibuffer-completion-predicate "")))
634 (if (or icicle-dir-candidate-can-exit-p
635 (not (eq (car bounds) (length result))))
636 ;; $$$$$$ (not (eq minibuffer-completion-table 'read-file-name-internal))
637 ;; $$$$$$ (not (file-directory-p (field-string (point-max)))))
638 (exit-minibuffer)
639 ;; The candidate chosen leads to a new set of candidates (e.g., it is a dir).
640 ;; Do not exit the minibuffer yet.
641 (let ((mini (active-minibuffer-window)))
642 (select-window mini)
643 (when minibuffer-auto-raise (raise-frame (window-frame mini))))))))))))
644
645 ((= emacs-major-version 21) ; Emacs 21
646 (defun icicle-choose-completion-string (choice &optional buffer base-size)
647 "Switch to BUFFER and insert the completion choice CHOICE.
648 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
649 to keep. If it is nil, we call `choose-completion-delete-max-match'
650 to decide what to delete.
651 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
652 the following is true:
653 - it is reading a file name, CHOICE is a directory, and
654 `icicle-dir-candidate-can-exit-p' is nil
655 - `completion-no-auto-exit' is non-nil
656 - this is just a `lisp-complete-symbol' completion."
657 (let* ((buffer (or buffer completion-reference-buffer))
658 (mini-p (save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
659 (buffer-name buffer)))))
660 ;; If BUFFER is a minibuffer, barf unless it's currently active.
661 (if (and mini-p (or (not (active-minibuffer-window))
662 (not (equal buffer (window-buffer (active-minibuffer-window))))))
663 (icicle-user-error "Minibuffer is not active for completion")
664 ;; Insert the completion into the buffer where completion was requested.
665 (set-buffer buffer)
666 (if base-size
667 (delete-region (+ base-size (if mini-p (icicle-minibuffer-prompt-end) (point-min)))
668 (if mini-p (point-max) (point)))
669 (choose-completion-delete-max-match choice))
670 (when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
671 (insert choice)
672 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
673 ;; Update point in the window that BUFFER is showing in.
674 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
675 ;; If completing for the minibuffer, exit it with this choice,
676 ;; unless this was a `lisp-complete-symbol' completion.
677 (and (not completion-no-auto-exit)
678 (equal buffer (window-buffer (minibuffer-window)))
679 (or minibuffer-completion-table
680 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
681 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
682 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
683 ;; or not reading a file name, or chosen file is not a directory.
684 (if (or icicle-dir-candidate-can-exit-p
685 (not (eq minibuffer-completion-table 'read-file-name-internal))
686 (not (file-directory-p (field-string (point-max)))))
687 (exit-minibuffer)
688 (let ((mini (active-minibuffer-window)))
689 (select-window mini)
690 (when minibuffer-auto-raise (raise-frame (window-frame mini))))))))))
691
692 (t ; Emacs 20
693 (defun icicle-choose-completion-string (choice &optional buffer base-size)
694 "Switch to BUFFER and insert the completion choice CHOICE.
695 BASE-SIZE, if non-nil, says how many characters of BUFFER's text
696 to keep. If it is nil, we call `choose-completion-delete-max-match'
697 to decide what to delete.
698 If BUFFER is the minibuffer, then exit the minibuffer, unless one of
699 the following is true:
700 - it is reading a file name, CHOICE is a directory, and
701 `icicle-dir-candidate-can-exit-p' is nil
702 - `completion-no-auto-exit' is non-nil
703 - this is just a `lisp-complete-symbol' completion."
704 (let* ((buffer (or buffer completion-reference-buffer))
705 (mini-p (save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
706 (buffer-name buffer)))))
707 ;; If BUFFER is a minibuffer, barf unless it's currently active.
708 (when (and mini-p (or (not (active-minibuffer-window))
709 (not (equal buffer (window-buffer (active-minibuffer-window))))))
710 (icicle-user-error "Minibuffer is not active for completion"))
711 ;; Insert the completion into the buffer where completion was requested.
712 (set-buffer buffer)
713 (if base-size
714 (delete-region (+ base-size (point-min)) (if mini-p (point-max) (point)))
715 (choose-completion-delete-max-match choice))
716 (when mini-p (goto-char (point-max))) ; $$$$$ (was unconditional)
717 (insert choice)
718 (remove-text-properties (- (point) (length choice)) (point) '(mouse-face nil))
719 ;; Update point in the window that BUFFER is showing in.
720 (let ((window (get-buffer-window buffer 0))) (set-window-point window (point)))
721 ;; If completing for the minibuffer, exit it with this choice,
722 ;; unless this was a `lisp-complete-symbol' completion.
723 (and (not completion-no-auto-exit)
724 (equal buffer (window-buffer (minibuffer-window)))
725 (or minibuffer-completion-table
726 (and icicle-mode (or icicle-extra-candidates icicle-proxy-candidates)))
727 (not (eq 'lisp-complete-symbol icicle-cmd-calling-for-completion))
728 ;; Exit the minibuffer if `icicle-dir-candidate-can-exit-p',
729 ;; or not reading a file name, or chosen file is not a directory.
730 (if (or icicle-dir-candidate-can-exit-p
731 (not (eq minibuffer-completion-table 'read-file-name-internal))
732 (not (file-directory-p (buffer-string))))
733 (exit-minibuffer)
734 (select-window (active-minibuffer-window))))))))
735
736
737 ;; REPLACE ORIGINAL `completion-setup-function' in `simple.el',
738 ;; saving it for restoration when you toggle `icicle-mode'.
739 ;;
740 ;; Don't print the help lines here. Do that in `icicle-display-completion-list' instead.
741 ;; That's so we can fit the `*Completions*' window to the buffer, including the help lines.
742 ;;
743 (unless (fboundp 'icicle-ORIG-completion-setup-function)
744 (defalias 'icicle-ORIG-completion-setup-function (symbol-function 'completion-setup-function)))
745
746 (when (< emacs-major-version 22)
747 (defun icicle-completion-setup-function ()
748 "Set up for completion. This goes in `completion-setup-hook'
749 so it is called after completion-list buffer text is written."
750 (save-excursion
751 (let* ((mainbuf (current-buffer))
752 (mbuf-contents (icicle-input-from-minibuffer))
753 (dir-of-input (and minibuffer-completing-file-name
754 ;; Emacs 20 bug: `substitute-in-file-name' barfs on "foo$": use condition-case.
755 (condition-case nil
756 (icicle-file-name-directory
757 (expand-file-name (substitute-in-file-name mbuf-contents)))
758 (error nil)))))
759 ;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
760 ;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
761 (when (and dir-of-input (or (icicle-get-safe this-command 'icicle-completing-command)
762 (not icicle-comp-base-is-default-dir-p)))
763 (with-current-buffer mainbuf (setq default-directory dir-of-input)))
764 (with-current-buffer standard-output
765 (completion-list-mode)
766 (set (make-local-variable 'completion-reference-buffer) mainbuf)
767 (setq completion-base-size
768 (cond ((and (eq minibuffer-completion-table 'read-file-name-internal)
769 icicle-comp-base-is-default-dir-p
770 (length default-directory)))
771 ((eq minibuffer-completion-table 'read-file-name-internal)
772 ;; For file name completion, use the number of chars before
773 ;; the start of the file name component at point.
774 (with-current-buffer mainbuf
775 (save-excursion (skip-chars-backward "^/")
776 (- (point) (icicle-minibuffer-prompt-end)))))
777 ((save-match-data (string-match "\\` \\*Minibuf-[0-9]+\\*\\'"
778 (buffer-name mainbuf)))
779 ;; Otherwise, in minibuffer, the whole input is being completed.
780 0))))))))
781
782 (when (or (= emacs-major-version 22) ; Emacs 22 or 23.1
783 (and (= emacs-major-version 23) (= emacs-minor-version 1)))
784 (defun icicle-completion-setup-function ()
785 "Set up for completion. This goes in `completion-setup-hook'
786 so it is called after completion-list buffer text is written."
787 (save-excursion
788 (let* ((mainbuf (current-buffer))
789 (mbuf-contents (minibuffer-completion-contents)) ; Get contents only up to point.
790 (dir-of-input (and minibuffer-completing-file-name
791 (icicle-file-name-directory
792 (expand-file-name (substitute-in-file-name mbuf-contents)))))
793 common-string-length)
794 ;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
795 ;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
796 (when (and dir-of-input (or (icicle-get-safe this-command 'icicle-completing-command)
797 (not icicle-comp-base-is-default-dir-p)))
798 (with-current-buffer mainbuf (setq default-directory dir-of-input)))
799 (with-current-buffer standard-output
800 (completion-list-mode)
801 (set (make-local-variable 'completion-reference-buffer) mainbuf)
802 (setq completion-base-size
803 (cond ((and minibuffer-completing-file-name icicle-comp-base-is-default-dir-p
804 (length default-directory)))
805 ((icicle-get-safe minibuffer-completion-table 'completion-base-size-function)
806 ;; To compute base size, a function can use the global value of
807 ;; `completion-common-substring' or `minibuffer-completion-contents'.
808 (with-current-buffer mainbuf
809 (funcall (get minibuffer-completion-table 'completion-base-size-function))))
810 (minibuffer-completing-file-name
811 ;; For file name completion, use the number of chars before
812 ;; the start of the file name component at point.
813 (with-current-buffer mainbuf
814 (save-excursion (skip-chars-backward completion-root-regexp)
815 (- (point) (minibuffer-prompt-end)))))
816 ((and (boundp 'minibuffer-completing-symbol) minibuffer-completing-symbol)
817 nil)
818 ;; Otherwise, in minibuffer, the base size is 0.
819 ((minibufferp mainbuf) 0)))
820 (setq common-string-length
821 (cond (completion-common-substring (length completion-common-substring))
822 (completion-base-size (- (length mbuf-contents) completion-base-size))))
823 ;; Put faces on first uncommon characters and common parts.
824 (when (and (integerp common-string-length) (>= common-string-length 0))
825 (let ((element-start (point-min))
826 (maxp (point-max))
827 element-common-end)
828 (while (and (setq element-start (next-single-property-change element-start 'mouse-face))
829 (< (setq element-common-end (+ element-start common-string-length))
830 maxp))
831 (when (get-char-property element-start 'mouse-face)
832 (when (and (> common-string-length 0)
833 (get-char-property (1- element-common-end) 'mouse-face))
834 (put-text-property element-start element-common-end
835 'font-lock-face 'completions-common-part))
836 (when (get-char-property element-common-end 'mouse-face)
837 (put-text-property element-common-end (1+ element-common-end)
838 'font-lock-face 'completions-first-difference)))))))))))
839
840 (when (or (> emacs-major-version 23) ; Emacs 23.2+
841 (and (= emacs-major-version 23) (>= emacs-minor-version 2)))
842 (defun icicle-completion-setup-function ()
843 "Set up for completion. This goes in `completion-setup-hook'
844 so it is called after completion-list buffer text is written."
845 ;; I could perhaps get rid of even more of the vanilla vestiges here...
846 (save-excursion
847 (let ((mainbuf (current-buffer))
848 (dir-of-input (and minibuffer-completing-file-name
849 (icicle-file-name-directory
850 (expand-file-name
851 (substitute-in-file-name (minibuffer-completion-contents)))))))
852 ;; If reading file name and either `icicle-comp-base-is-default-dir-p' is nil or this is a
853 ;; completion command, then set `default-directory' so it will be copied into `*Completions*'.
854 (when (and dir-of-input (or (icicle-get-safe this-command 'icicle-completing-command)
855 (not icicle-comp-base-is-default-dir-p)))
856 (with-current-buffer mainbuf (setq default-directory dir-of-input)))
857 (with-current-buffer standard-output
858 (completion-list-mode)
859 (set (make-local-variable 'completion-reference-buffer) mainbuf))))))
860
861 (defun icicle-insert-Completions-help-string ()
862 "Add or remove help in `*Completions*'.
863 This is controlled by `icicle-show-Completions-help-flag'. Show help
864 only if that option is non-nil."
865 (if icicle-show-Completions-help-flag
866 (let ((instruction2 (or (and icicle-mode (substitute-command-keys
867 (concat "(\\<minibuffer-local-completion-map>"
868 "\\[icicle-minibuffer-help]: help) ")))
869 ""))
870 instruction1)
871 (cond ((< emacs-major-version 22)
872 (setq instruction1 (if window-system ; We have a mouse.
873 (substitute-command-keys "Click \\<completion-list-mode-map>\
874 \\[mouse-choose-completion] on a completion to select it. ")
875 (substitute-command-keys ; No mouse.
876 "In this buffer, type \\<completion-list-mode-map>\
877 \\[choose-completion] to select the completion near point. "))))
878 ((>= emacs-major-version 22)
879 (setq instruction1 (if (display-mouse-p) ; We have a mouse.
880 (substitute-command-keys
881 "Click \\<completion-list-mode-map>\
882 \\[mouse-choose-completion] or type \\[choose-completion] on a completion to select it. ")
883 (substitute-command-keys ; No mouse.
884 "In this buffer, type \\<completion-list-mode-map>\
885 \\[choose-completion] to select the completion near point. ")))))
886 (goto-char (point-min))
887 (put-text-property 0 (length instruction1) 'face 'icicle-Completions-instruction-1
888 instruction1)
889 (put-text-property 0 (length instruction2) 'face 'icicle-Completions-instruction-2
890 instruction2)
891 (insert instruction1 instruction2 "\n"))
892
893 ;; Not showing help. Remove standard Emacs help string.
894 (goto-char (point-min))
895 (re-search-forward "Possible completions are:\n")
896 (delete-region (point-min) (point))))
897
898 (defun icicle-read-from-minibuf-nil-default (prompt &optional initial-contents keymap read hist
899 default-value inherit-input-method)
900 "Like `read-from-minibuffer', but return nil for empty input.
901 Args are as for `read-from-minibuffer'.
902 If nothing is input, then nil is returned."
903 (let ((input (read-from-minibuffer prompt initial-contents keymap nil hist default-value
904 inherit-input-method)))
905 (if (string= "" input) nil (if read (car (read-from-string input)) input))))
906
907 (defun icicle-completing-read-history (prompt &optional hist pred init-input def inherit-i-m)
908 "Lax `completing-read' against entries in history HIST.
909 Arguments are as for `completing-read'. HIST is a symbol that is a
910 history variable. It defaults to `minibuffer-history'. Completion is
911 lax: a match is not required."
912 (setq hist (or hist 'minibuffer-history))
913 (let ((hist-val (icicle-remove-duplicates (symbol-value hist))))
914 (when (and (consp hist-val) (not (stringp (car hist-val)))) ; Convert, e.g. `comand-history'.
915 (setq hist-val (mapcar #'prin1-to-string hist-val)))
916 (completing-read prompt (mapcar #'list hist-val) pred nil init-input hist def inherit-i-m)))
917
918 ;; Based on the Emacs 22 C code that defined `completing-read'.
919 (defun icicle-lisp-vanilla-completing-read (prompt collection &optional predicate require-match
920 initial-input hist def inherit-input-method)
921 "Lisp version of vanilla Emacs `completing-read'."
922 (let ((pos 0) val histvar histpos position init)
923 (setq init initial-input
924 minibuffer-completion-table collection
925 minibuffer-completion-predicate predicate
926 minibuffer-completion-confirm (and (not (eq require-match t)) require-match)
927 position nil)
928 (when init
929 (when (consp init) (setq position (cdr init)
930 init (car init)))
931 (unless (stringp init)
932 (error "`icicle-lisp-vanilla-completing-read', INIT not a string: %S" init))
933 (if (not position)
934 (setq pos (1+ (length init))) ; Default is to put cursor at end of INITIAL-INPUT.
935 (unless (integerp position)
936 (error "`icicle-lisp-vanilla-completing-read', POSITION not an integer: %S" position))
937 (setq pos (1+ position)))) ; Convert zero-based to one-based.
938 (if (symbolp hist)
939 (setq histvar hist
940 histpos nil)
941 (setq histvar (car-safe hist)
942 histpos (cdr-safe hist)))
943 (unless histvar (setq histvar 'minibuffer-history))
944 (unless histpos (setq histpos 0))
945 ;; $$$$$$
946 ;; (setq val (read-from-minibuffer
947 ;; prompt
948 ;; (cons init pos) ; initial-contents
949 ;; (if (not require-match) ; key map
950 ;; (if (or (not minibuffer-completing-file-name)
951 ;; (eq minibuffer-completing-file-name 'lambda)
952 ;; (not (boundp 'minibuffer-local-filename-completion-map)))
953 ;; minibuffer-local-completion-map
954 ;; minibuffer-local-filename-completion-map)
955 ;; (if (or (not minibuffer-completing-file-name)
956 ;; (eq minibuffer-completing-file-name 'lambda)
957 ;; (not (boundp 'minibuffer-local-filename-must-match-map)))
958 ;; minibuffer-local-must-match-map
959 ;; minibuffer-local-filename-must-match-map))
960 ;; nil histvar def inherit-input-method))
961 (setq val (read-from-minibuffer
962 prompt
963 (cons init pos) ; initial-contents
964 (if (not require-match) ; keymap
965 (if (or (not minibuffer-completing-file-name)
966 (eq minibuffer-completing-file-name 'lambda)
967 (not (boundp 'minibuffer-local-filename-completion-map)))
968 minibuffer-local-completion-map
969 (if (fboundp 'make-composed-keymap) ; Emacs 24, starting July 2011.
970 (make-composed-keymap minibuffer-local-filename-completion-map
971 minibuffer-local-completion-map)
972 minibuffer-local-filename-completion-map))
973 (if (or (not minibuffer-completing-file-name)
974 (eq minibuffer-completing-file-name 'lambda)
975 (and (not (fboundp 'make-composed-keymap)) ; Emacs 24, starting July 2011.
976 (not (boundp 'minibuffer-local-filename-must-match-map))))
977 minibuffer-local-must-match-map
978 (if (fboundp 'make-composed-keymap) ; Emacs 24, starting July 2011.
979 (make-composed-keymap minibuffer-local-filename-completion-map
980 minibuffer-local-must-match-map)
981 minibuffer-local-filename-must-match-map)))
982 nil histvar def inherit-input-method))
983 ;; Use `icicle-filtered-default-value', not DEF, because `read-from-minibuffer' filters it.
984 (when (consp icicle-filtered-default-value) ; Emacs 23 lets DEF be a list of strings - use first.
985 (setq icicle-filtered-default-value (car icicle-filtered-default-value)))
986 (when (and (stringp val) (string= val "") icicle-filtered-default-value)
987 (setq val icicle-filtered-default-value))
988 val))
989
990
991 ;; REPLACE ORIGINAL `completing-read' (built-in function),
992 ;; saving it for restoration when you toggle `icicle-mode'.
993 ;;
994 ;; Allows for completion candidates that are lists of strings.
995 ;; Allows for reading and returning completion candidates that are strings with properties.
996 ;; Adds completion status indicator to minibuffer and mode-line lighter.
997 ;; Removes `*Completions*' window.
998 ;;
999 ;; We use HIST-m@%=!$+&^*z instead of HIST, to avoid name capture by `minibuffer-history-variable's
1000 ;; value. If we didn't need to be Emacs 20-compatible, then we could employ
1001 ;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
1002 ;;
1003 (unless (fboundp 'icicle-ORIG-completing-read)
1004 (defalias 'icicle-ORIG-completing-read (symbol-function 'completing-read)))
1005
1006 (defun icicle-completing-read (prompt collection &optional predicate require-match
1007 initial-input hist-m@%=!$+&^*z def inherit-input-method)
1008 "Read string in minibuffer, with completion and cycling of completions.
1009 Prefix completion via \\<minibuffer-local-completion-map>\
1010 `\\[icicle-prefix-word-complete]' (word) and `\\[icicle-prefix-complete]' (full).
1011 Apropos (regexp) completion via `\\[icicle-apropos-complete]'.
1012
1013 Prefix cycling of candidate completions via `\\[icicle-previous-prefix-candidate]' and \
1014 `\\[icicle-next-prefix-candidate]'.
1015 Apropos cycling of candidate completions via `\\[icicle-previous-apropos-candidate]' and \
1016 `\\[icicle-next-apropos-candidate]'.
1017
1018 Cycling of past minibuffer inputs via `\\[previous-history-element]' and \
1019 `\\[next-history-element]'.
1020 Completing past minibuffer inputs via `\\[icicle-insert-history-element]'.
1021
1022 Case is ignored if `completion-ignore-case' is non-nil.
1023 Position of the cursor (point) and the mark during completion cycling
1024 is determined by `icicle-point-position-in-candidate' and
1025 `icicle-mark-position-in-candidate', respectively.
1026 Highlighting of the matched part of completion candidates during
1027 cycling is determined by `icicle-match-highlight-minibuffer',
1028 `icicle-match-highlight-Completions', and
1029 `icicle-common-match-highlight-Completions'.
1030
1031 Use `\\[icicle-minibuffer-help]' during completion for more information on completion and key
1032 bindings in Icicle mode.
1033
1034 PROMPT is a string to prompt with. It normally ends in a colon and a
1035 space. If PROMPT has non-nil text property `icicle-fancy-candidates'
1036 on its first character, then completion candidates can be fancy - they
1037 can have properties. However, if all of the candidates would be
1038 acceptable to vanilla Emacs, then PROMPT need not use property
1039 `icicle-fancy-candidates', even for candidates that have text
1040 properties. Property `icicle-fancy-candidates' is needed only for
1041 candidates that require encoding and decoding to store and retrieve
1042 properties. See the Icicles doc, section `Programming with Fancy
1043 Candidates'.
1044
1045 COLLECTION is an obarray or an alist whose elements' cars are strings.
1046 It can also be a function that performs the completion itself.
1047 In Emacs 22 or later, it can also be a hash table or list of strings.
1048
1049 In Icicle mode, the car of an alist entry can also be a list of
1050 strings. In this case, the completion candidate is a
1051 multi-completion. The strings are joined pairwise with
1052 `icicle-list-join-string' to form the completion candidate seen by the
1053 user. You can use variable `icicle-candidate-properties-alist' to
1054 control the appearance of multi-completions in buffer `*Completions*'.
1055 You can use variables `icicle-list-use-nth-parts' and
1056 `icicle-list-nth-parts-join-string' to control the minibuffer behavior
1057 of multi-completions. See the Icicles documentation for more
1058 information.
1059
1060 PREDICATE limits completion to a subset of COLLECTION.
1061
1062 See `try-completion' and `all-completions' for more details on
1063 completion, COLLECTION, and PREDICATE.
1064
1065 REQUIRE-MATCH can take any of these values:
1066 * nil means the user can exit using any input.
1067 * t means the user can exit only if the input is (or completes to) an
1068 element of COLLECTION or is null.
1069 * In Emacs 23 or later:
1070 - `confirm' means the user can exit with any input, but if the input
1071 is not an element of COLLECTION then confirmation is needed.
1072 - `confirm-after-completion' is similar, except that with
1073 non-matching input exit is allowed only just after completing.
1074 * Anything else behaves like t, except that hitting `\\[exit-minibuffer]' does not
1075 exit if it performs non-null completion.
1076
1077 Regardless of the value of REQUIRE-MATCH, if the user input is empty
1078 then the function returns a string that is based on the value of DEF:
1079
1080 * DEF, if DEF is a string
1081 * the first element of DEF, if DEF is a non-empty list
1082 * the empty string, if DEF is nil
1083
1084 If option `icicle-require-match-flag' is non-nil, it overrides the
1085 value of REQUIRE-MATCH.
1086
1087 If INITIAL-INPUT is non-nil, insert it in the minibuffer initially,
1088 with point positioned at the end. If it is (STRING . POSITION), the
1089 initial input is STRING, but point is placed at zero-indexed position
1090 POSITION in STRING. (This is different from `read-from-minibuffer'
1091 and related functions, which use one-indexing for POSITION.)
1092
1093 INITIAL-INPUT is considered deprecated by vanilla Emacs, but not by
1094 Icicles. If INITIAL-INPUT is nil and DEF is non-nil, the user can use
1095 `next-history-element' to yank DEF into the minibuffer.
1096
1097 HIST, if non-nil, specifies a history list and optionally the initial
1098 position in the list. It can be a symbol, which is the history list
1099 variable to use, or it can be a cons cell (HISTVAR . HISTPOS). If a
1100 cons cell, HISTVAR is the history list variable to use, and HISTPOS is
1101 the initial position (the position in the list used by the minibuffer
1102 history commands). For consistency, you should also specify that
1103 element of the history as the value of INITIAL-INPUT. Positions are
1104 counted starting from 1 at the beginning of the list. The variable
1105 `history-length' controls the maximum length of a history list.
1106
1107 DEF, if non-nil, is the default value or (Emacs 23+ only) the list of
1108 default values. Option `icicle-default-value' controls the treatment
1109 of the default value (or the first default value, if DEF is a list):
1110 whether it is shown in the prompt, substituted for an empty
1111 INITIAL-INPUT, and so on. If `icicle-default-value' is t then option
1112 `icicle-default-in-prompt-format-function' is used to format DEF for
1113 its addition to PROMPT.
1114
1115 If INHERIT-INPUT-METHOD is non-nil, the minibuffer inherits the
1116 current input method and the setting of `enable-multibyte-characters'.
1117
1118 Both completion candidates and DEF are filtered using these Icicles
1119 variables:
1120 `icicle-must-match-regexp'
1121 `icicle-must-not-match-regexp'
1122 `icicle-must-pass-predicate'
1123
1124 Completion ignores case when `completion-ignore-case' is non-nil."
1125 (unless (stringp icicle-initial-value) (setq icicle-initial-value "")) ; Convert nil to "".
1126 (unless initial-input (setq initial-input icicle-initial-value))
1127 (if (consp initial-input)
1128 (setq icicle-initial-value (car initial-input))
1129 (setq initial-input (format "%s" initial-input) ; Convert symbol to string
1130 icicle-initial-value initial-input))
1131 (setq icicle-nb-of-other-cycle-candidates 0)
1132
1133 ;; Use DEF for INITIAL-INPUT also, if `icicle-default-value' says so.
1134 (when (and def icicle-default-value (not (eq icicle-default-value t))
1135 (stringp initial-input) (string= "" initial-input))
1136 ;; Filter DEF using `icicle-filter-wo-input'. Done in `read-from-minibuffer' anyway, but we
1137 ;; must also do it here, to reuse the correct default value for the init value.
1138 (if (atom def)
1139 (setq initial-input (or (icicle-filter-wo-input def) "")) ; Ensure that it is non-nil.
1140 (let ((found nil)
1141 (def1 def))
1142 (while (and (not found) def1)
1143 (setq found (icicle-filter-wo-input (car def1))
1144 def1 (cdr def1)))
1145 (setq initial-input (or found ""))))
1146 (when (memq icicle-default-value '(insert-start preselect-start))
1147 (setq initial-input (cons initial-input 0))))
1148
1149 ;; Override REQUIRE-MATCH as needed.
1150 (setq require-match (case icicle-require-match-flag
1151 ((nil) require-match)
1152 (no-match-required nil)
1153 (partial-match-ok t)
1154 (full-match-required 'full-match-required))
1155 icicle-require-match-p require-match)
1156 (icicle-highlight-lighter)
1157 (let* ((minibuffer-history-variable minibuffer-history-variable)
1158 ;; $$$$$$$$$$ `minibuffer-completion-table' binding needed? `setq' in `*-lisp-vanilla-*'.
1159 (minibuffer-allow-text-properties t) ; This is nil for completion in vanilla Emacs.
1160 (minibuffer-completion-table collection)
1161 (icicle-fancy-cands-internal-p (or icicle-whole-candidate-as-text-prop-p
1162 icicle-fancy-candidates-p
1163 (get-text-property 0 'icicle-fancy-candidates prompt)))
1164 result)
1165 ;; Transform a cons collection to what is expected for `minibuffer-completion-table'.
1166 (when icicle-fancy-cands-internal-p
1167 (let ((c+p (icicle-mctize-all collection predicate)))
1168 (setq collection (car c+p) ; After banalizing for vanilla Emacs.
1169 predicate (cadr c+p))))
1170 ;; $$$$$$ (setq minibuffer-completion-table collection)
1171 (when def (setq prompt (icicle-handle-default-for-prompt prompt def (eq icicle-default-value t))))
1172 (cond ((not icicle-mode)
1173 (setq result (icicle-lisp-vanilla-completing-read
1174 prompt collection predicate require-match initial-input
1175 hist-m@%=!$+&^*z def inherit-input-method)))
1176 (t
1177 (let* ((minibuffer-prompt-properties (and (boundp 'minibuffer-prompt-properties)
1178 (icicle-remove-property ; Emacs 21+ only
1179 'face minibuffer-prompt-properties)))
1180 ;; Can't be file-name completion unless it's a function.
1181 (minibuffer-completing-file-name (and (functionp collection)
1182 minibuffer-completing-file-name))
1183 ;; If not a recursive minibuffer, save original domain-defining variables,
1184 ;; so user can restore them using `icicle-recomplete-from-original-domain'.
1185 (top-level-p (< (minibuffer-depth) 1))
1186 (icicle-orig-minibuffer-completion-table (if top-level-p
1187 minibuffer-completion-table
1188 icicle-orig-minibuffer-completion-table))
1189 (icicle-orig-minibuffer-completion-pred (if top-level-p
1190 predicate
1191 icicle-orig-minibuffer-completion-pred))
1192 (icicle-orig-must-pass-after-match-pred (if top-level-p
1193 icicle-must-pass-after-match-predicate
1194 icicle-orig-must-pass-after-match-pred))
1195 (icicle-orig-must-match-regexp (if top-level-p
1196 icicle-must-match-regexp
1197 icicle-orig-must-match-regexp))
1198 (icicle-orig-must-not-match-regexp (if top-level-p
1199 icicle-must-not-match-regexp
1200 icicle-orig-must-not-match-regexp))
1201 (icicle-orig-must-pass-predicate (if top-level-p
1202 icicle-must-pass-predicate
1203 icicle-orig-must-pass-predicate)))
1204 (when (< emacs-major-version 21)
1205 (setq prompt (concat (and icicle-candidate-action-fn "+ ") prompt)))
1206 (setq result (catch 'icicle-read-top
1207 (icicle-lisp-vanilla-completing-read
1208 prompt collection predicate require-match initial-input
1209 hist-m@%=!$+&^*z def inherit-input-method)))
1210 (icicle-unpropertize-completion result))))
1211 ;; HACK. Without this, when REQUIRE-MATCH is non-nil, `*Completions*' window
1212 ;; does not disappear.
1213 (when require-match (icicle-remove-Completions-window))
1214 result))
1215
1216 (defun icicle-handle-default-for-prompt (prompt default include)
1217 "Return PROMPT, possibly changed to format or remove the DEFAULT value.
1218 Argument INCLUDE:
1219 * nil means do not include DEFAULT in prompt. Remove it if there.
1220 * non-nil means include DEFAULT, formatted according to
1221 `icicle-default-in-prompt-format-function'.
1222
1223 In the existing PROMPT before modification, recognizes inclusion of
1224 a default value according to these possible patterns:
1225
1226 `minibuffer-default-in-prompt-regexps'
1227 \"(default ___):\"
1228 \"(default is ___):\"
1229 \" [___] \""
1230 (when (consp default) (setq default (car default)))
1231 ;; Remove the default, if already there.
1232 (dolist (rgx (if (boundp 'minibuffer-default-in-prompt-regexps) ; Get rid of HINT if already there.
1233 minibuffer-default-in-prompt-regexps
1234 '(("\\( (default\\(?: is\\)? \\(.*\\))\\):? \\'" 1)
1235 ("\\( \\[.*\\]\\):? *\\'" 1))))
1236 (setq prompt (replace-regexp-in-string (car rgx) "" prompt nil nil (cadr rgx))))
1237 ;; $$$$$$$$$ (when (icicle-file-name-input-p) (setq default (file-name-nondirectory default)))
1238 ;; Add non-nil DEFAULT, if INCLUDE.
1239 (if (and default include)
1240 (replace-regexp-in-string ".*\\(\\): *\\'"
1241 (funcall icicle-default-in-prompt-format-function default)
1242 prompt nil t 1)
1243 prompt))
1244
1245
1246 (defun icicle-mctize-all (coll pred)
1247 "Transform collection COLL and predicate PRED for vanilla completion.
1248 COLL is an Icicles collection argument acceptable to
1249 `icicle-completing-read' but not necessarily to vanilla
1250 `completing-read': COLL can contain multi-completions.
1251 PRED is a predicate.
1252
1253 Returns a new two-element list of the new collection and predicate:
1254 \(MCT NEWPRED), where MCT is COLL transformed and NEWPRED is PRED
1255 transformed. MCT is a collection suitable for vanilla
1256 `completing-read'.
1257
1258 COLL is transformed to MCT by applying `icicle-mctized-full-candidate'
1259 to each of its elements.
1260
1261 If PRED is non-nil, then NEWPRED is a predicate that applies PRED to
1262 the cdr of an MCT entry. If PRED is nil, so is NEWPRED."
1263 (when (consp coll)
1264 ;; Copy alist collection COLL, so we don't change the original alist in any way.
1265 ;; Change each entry in COLL using `icicle-mctized-full-candidate'.
1266 (setq coll (mapcar #'icicle-mctized-full-candidate coll))
1267 ;; Convert non-nil PRED so that, for a cons entry with a string car, PRED uses the cdr
1268 ;; (which is the original entry) instead.
1269 (and pred (lexical-let ((new-pred pred))
1270 (setq pred (lambda (x)
1271 (funcall new-pred (if (and (consp x) (stringp (car x))) (cdr x) x)))))))
1272 (list coll pred))
1273
1274 (defun icicle-mctized-full-candidate (cand)
1275 "Return MCT candidate that corresponds to full candidate CAND.
1276 See the source code for details."
1277 ;; If neither `icicle-fancy-cands-internal-p' nor `icicle-whole-candidate-as-text-prop-p' is
1278 ;; non-nil, then just return CAND.
1279 ;; Otherwise:
1280 ;; If CAND is a string A, we change it to (A) and then treat that (as follows).
1281 ;; If CAND is (A . B), where A is a string, then we change it to (S A . B), where S is a copy
1282 ;; of A. This way, the cdr of each MCT candidate is the original alist candidate, (A . B).
1283 ;; If CAND is (M . B), where M is a multi-completion (X Y Z...), then we change it to
1284 ;; (M' A . B), where M' is the display string for the multi-completion M.
1285 ;; Otherwise, we make no change to CAND.
1286 ;; If `icicle-whole-candidate-as-text-prop-p' is non-nil and the MCT candidate is a cons (X A . B)
1287 ;; with a string car X, then we put the cdr, (A . B), as a text property on the car X, so
1288 ;; we can get back the original (A . B) from the car.
1289 (if (not (or icicle-fancy-cands-internal-p icicle-whole-candidate-as-text-prop-p))
1290 cand
1291 (let ((new-cand
1292 (cond ((and (consp cand) ; Multi-completion: (("aa" "bb") . cc) ->
1293 (consp (car cand)) ; ("aa^G\nbb\n\n" ("aa" "bb") . cc)
1294 (stringp (caar cand)))
1295 ;; $$$$$$ (cons (mapconcat #'identity (car cand) icicle-list-join-string)
1296 (cons (mapconcat #'identity (car cand) icicle-list-join-string) cand))
1297 ((and (consp cand) (stringp (car cand))) ; ("aa" . cc) -> ("aa" "aa" . cc)
1298 (cons (copy-sequence (car cand)) cand))
1299 ((stringp cand) ; "aa" -> ("aa" "aa")
1300 (list (copy-sequence cand) cand))
1301 (t ; Anything else: (aa), aa -> no change
1302 cand))))
1303 ;; Put original alist candidates on display candidates (strings), as a text property.
1304 (when (and icicle-whole-candidate-as-text-prop-p (consp new-cand) (stringp (car new-cand)))
1305 (icicle-put-whole-cand-prop new-cand))
1306 new-cand)))
1307
1308 (defun icicle-put-whole-cand-prop (cand)
1309 "Put cdr of CAND on its car, as text property `icicle-whole-candidate'.
1310 This has no side effects.
1311 Returns a new propertized string corresponding to (car CAND)."
1312 (let ((text-cand (copy-sequence (car cand))))
1313 (put-text-property 0 (length text-cand) 'icicle-whole-candidate (cdr cand) text-cand)
1314 (setcar cand text-cand)
1315 text-cand))
1316
1317 (defun icicle-mctized-display-candidate (cand)
1318 "Return MCT candidate that corresponds to display candidate CAND."
1319 (let ((full-cand (or (funcall icicle-get-alist-candidate-function cand) (list cand))))
1320 (cons cand full-cand)))
1321
1322 (defun icicle-replace-mct-cand-in-mct (old new)
1323 "Replace OLD candidate with NEW in `minibuffer-completion-table'.
1324 Both OLD and NEW have been mctized. That is, they are ready for
1325 `minibuffer-completion-table'."
1326 (let ((newlist minibuffer-completion-table))
1327 (catch 'icicle-replace-cand-in-mct
1328 (while newlist
1329 (when (equal (car newlist) old)
1330 (setcar newlist new)
1331 (throw 'icicle-replace-cand-in-mct nil))
1332 (setq newlist (cdr newlist))))
1333 minibuffer-completion-table))
1334
1335 (defun icicle-read-file-name (prompt &optional dir default-filename
1336 require-match initial-input predicate history)
1337 "Read file name, prompting with PROMPT and completing in directory DIR.
1338 Value is not expanded---you must call `expand-file-name' yourself.
1339 DIR should be an absolute directory name. It defaults to the value of
1340 `default-directory'.
1341 Default the name to DEFAULT-FILENAME if user exits the minibuffer with
1342 the same non-empty string that was inserted by this function.
1343 (If DEFAULT-FILENAME is omitted, the visited file name is used,
1344 but if INITIAL-INPUT is specified, that combined with DIR is used.)
1345 If the user exits with an empty minibuffer, this function returns
1346 an empty string. (This can only happen if the user erased the
1347 pre-inserted contents or if `insert-default-directory' is nil.)
1348 Fourth arg REQUIRE-MATCH non-nil means require existing file's name.
1349 Non-nil and non-t means also require confirmation after completion.
1350 Fifth arg INITIAL-INPUT specifies text to start with.
1351 If optional sixth arg PREDICATE is non-nil, possible completions and
1352 the resulting file name must satisfy `(funcall predicate NAME)'.
1353 This argument is only available starting with Emacs 22.
1354 Sixth arg HISTORY is an alternative minibuffer to use, instead of
1355 `file-name-history', which is used by default. (HISTORY is not
1356 available for vanilla `read-file-name'.)
1357
1358 Both completion candidates and DEFAULT-FILENAME are filtered using
1359 these Icicles variables:
1360 `icicle-must-match-regexp'
1361 `icicle-must-not-match-regexp'
1362 `icicle-must-pass-predicate'
1363
1364 Directory names are highlighted in `*Completions*' using face
1365 `icicle-special-candidate'.
1366
1367 If option `icicle-require-match-flag' is non-nil, it overrides the
1368 value of REQUIRE-MATCH.
1369
1370 If option `icicle-add-proxy-candidates-flag' is non-nil, then the
1371 following proxy file-name candidates are included. (This inclusion
1372 can be toggled at any time from the minibuffer, using `C-M-_'.)
1373
1374 * `*mouse-2 file name*' - Click `mouse-2' on a file name to choose it.
1375 * `*point file name*' - Use the file name at point (cursor).
1376 * Single-quoted file-name variables - Use the variable's value.
1377
1378 Candidates `*mouse-2 file name*' and `*point file name*' are available
1379 only if library `ffap.el' can be loaded. A file-name variable has
1380 custom type `file' or (file :must-match t).
1381
1382 If this command was invoked with the mouse, use a file dialog box if
1383 `use-dialog-box' is non-nil, and the window system or X toolkit in use
1384 provides a file dialog box.
1385
1386 See also `read-file-name-completion-ignore-case' (Emacs version > 21)
1387 and `read-file-name-function'."
1388 (unwind-protect
1389 (let* ((mouse-file "*mouse-2 file name*")
1390 (icicle-special-candidate-regexp (or icicle-special-candidate-regexp ".+/$"))
1391 (minibuffer-completing-file-name t)
1392 (read-file-name-predicate (and (boundp 'read-file-name-predicate)
1393 read-file-name-predicate))
1394 (ffap-available-p (or (require 'ffap- nil t) (require 'ffap nil t)))
1395 ;; The next four prevent slowing down `ffap-guesser'.
1396 (ffap-alist nil) (ffap-machine-p-known 'accept)
1397 (ffap-url-regexp nil) (ffap-shell-prompt-regexp nil)
1398 (fap
1399 (if (and (eq major-mode 'dired-mode) (fboundp 'dired-get-file-for-visit))
1400 (condition-case nil
1401 (abbreviate-file-name (dired-get-file-for-visit))
1402 (error nil))
1403 (and ffap-available-p (ffap-guesser))))
1404 (icicle-proxy-candidates
1405 (append
1406 (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
1407 (append (and fap (list "*point file name*"))
1408 (and ffap-available-p (list mouse-file))
1409 (let ((ipc ()))
1410 (mapatoms
1411 (lambda (cand)
1412 (when (and (user-variable-p cand)
1413 (condition-case nil
1414 (icicle-var-is-of-type-p cand '(file (file :must-match t)))
1415 (error nil)))
1416 (push (concat "'" (symbol-name cand) "'") ipc))))
1417 ipc)))
1418 icicle-proxy-candidates))
1419 result)
1420
1421 ;; ;; $$$$$$ Does Emacs 23+ need explicit directory? If so, add these three lines
1422 ;; (unless dir (setq dir default-directory))
1423 ;; (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
1424 ;; (setq dir (abbreviate-file-name dir)) ; Use `~' for home directory.
1425
1426 (setq result (icicle-read-file-name-1 prompt dir default-filename
1427 require-match initial-input predicate history))
1428 (when ffap-available-p
1429 (cond ((save-match-data (string-match "*point file name\\*$" result))
1430 (setq result fap))
1431 ((save-match-data (string-match "*mouse-2 file name\\*$" result))
1432 (setq result (progn (let ((e (read-event "Click `mouse-2' on file name")))
1433 (read-event) ; Get rid of mouse up event.
1434 (save-excursion
1435 (mouse-set-point e)
1436 (if (and (eq major-mode 'dired-mode)
1437 (fboundp 'dired-get-file-for-visit)) ; In `dired+.el'.
1438 (condition-case nil ; E.g. error: not on file line (ignore)
1439 (abbreviate-file-name (dired-get-file-for-visit))
1440 (error "No such file"))
1441 (or (ffap-guesser) (error "No such file"))))))))))
1442 (icicle-unpropertize-completion result)
1443 (let* ((temp (member (file-name-nondirectory result) icicle-proxy-candidates))
1444 (symb (and temp (intern (substring (car temp) 1 (1- (length (car temp))))))))
1445 (when (and symb (boundp symb)) (setq result (symbol-value symb))))
1446 result)
1447 ;; Because we do this here, if a command that uses `icicle-read-file-name' needs the proxies
1448 ;; afterward then it needs to save a copy of them.
1449 (setq icicle-proxy-candidates ())))
1450
1451 (defun icicle-read-file-name-1 (prompt &optional dir default-filename
1452 require-match initial-input predicate history)
1453 "Helper function for `icicle-read-file-name'."
1454 (setq icicle-nb-of-other-cycle-candidates 0
1455 icicle-initial-value (or initial-input (if (stringp icicle-initial-value)
1456 icicle-initial-value
1457 "")))
1458 (icicle-fix-default-directory) ; Make sure there are no backslashes in it.
1459 (unless (string= "" icicle-initial-value) (setq initial-input icicle-initial-value))
1460
1461 ;; Use DEFAULT-FILENAME for INITIAL-INPUT also, if `icicle-default-value' says so.
1462 ;; But if so, remove the directory part first.
1463 ;; Note that if DEFAULT-FILENAME is null, then we let INITIAL-INPUT remain null too.
1464 (when (and default-filename icicle-default-value (not (eq icicle-default-value t))
1465 ;; We don't use the same test as for `completing-read':
1466 ;; (stringp initial-input) (string= "" initial-input))
1467 (string= "" icicle-initial-value))
1468 ;; Filter DEFAULT-FILENAME using `icicle-filter-wo-input'. Done in `read-from-minibuffer'
1469 ;; anyway, but we must also do it here, to reuse the correct default value for the init value.
1470 (if (atom default-filename)
1471 (setq initial-input (icicle-filter-wo-input (file-name-nondirectory default-filename)))
1472 (let ((found nil)
1473 (def1 default-filename))
1474 (while (and (not found) def1)
1475 (setq found (icicle-filter-wo-input (file-name-nondirectory (car def1)))
1476 def1 (cdr def1)))
1477 (setq initial-input (or found "")))))
1478
1479 ;; Override REQUIRE-MATCH as needed.
1480 (setq require-match (case icicle-require-match-flag
1481 ((nil) require-match)
1482 (no-match-required nil)
1483 (partial-match-ok t)
1484 (full-match-required 'full-match-required))
1485 icicle-require-match-p require-match)
1486 (icicle-highlight-lighter)
1487 (let ((read-file-name-function nil)
1488 (minibuffer-history-variable (or history minibuffer-history-variable))
1489 result)
1490 (let ((minibuffer-prompt-properties
1491 (and (boundp 'minibuffer-prompt-properties) ; Emacs 21+ only
1492 (icicle-remove-property 'face minibuffer-prompt-properties))))
1493 (when (< emacs-major-version 21)
1494 (setq prompt (concat (and icicle-candidate-action-fn "+ ") prompt)))
1495 (if (and history (eq icicle-orig-read-file-name-fn 'read-file-name-default))
1496 ;; Use `icicle-read-file-name-default', which accepts a HISTORY arg.
1497 (setq result (catch 'icicle-read-top
1498 (funcall #'icicle-read-file-name-default
1499 prompt dir default-filename require-match initial-input predicate
1500 (or history 'file-name-history))))
1501 (condition-case nil ; If Emacs 22+, use PREDICATE arg.
1502 (setq result (catch 'icicle-read-top
1503 (funcall (or icicle-orig-read-file-name-fn 'read-file-name)
1504 prompt dir default-filename require-match initial-input predicate)))
1505 (wrong-number-of-arguments
1506 (setq result (catch 'icicle-read-top ; Try with neither (Emacs 20-21).
1507 (funcall (or icicle-orig-read-file-name-fn 'read-file-name) prompt dir
1508 default-filename require-match initial-input)))))))
1509 ;; HACK. Without this, when REQUIRE-MATCH is non-nil, `*Completions*' window
1510 ;; does not disappear.
1511 (when require-match (icicle-remove-Completions-window))
1512 result))
1513
1514 (defun icicle-read-file-name-default (prompt &optional dir default-filename mustmatch initial predicate history)
1515 "Same as vanilla `read-file-name-default', except accepts HISTORY too."
1516 (setq history (or history 'file-name-history))
1517 (unless dir (setq dir default-directory))
1518 (unless (file-name-absolute-p dir) (setq dir (expand-file-name dir)))
1519 (unless default-filename
1520 (setq default-filename (if initial (expand-file-name initial dir) buffer-file-name)))
1521 (setq dir (abbreviate-file-name dir)) ; If DIR starts with user's homedir, change that to ~.
1522 (when default-filename ; Likewise for DEFAULT-FILENAME.
1523 (setq default-filename (if (consp default-filename)
1524 (mapcar 'abbreviate-file-name default-filename)
1525 (abbreviate-file-name default-filename))))
1526 (let ((insdef (cond ((and insert-default-directory (stringp dir))
1527 (if initial
1528 (cons (minibuffer--double-dollars (concat dir initial))
1529 (length (minibuffer--double-dollars dir)))
1530 (minibuffer--double-dollars dir)))
1531 (initial (cons (minibuffer--double-dollars initial) 0)))))
1532 (let ((completion-ignore-case read-file-name-completion-ignore-case)
1533 (minibuffer-completing-file-name t)
1534 (pred (or predicate 'file-exists-p))
1535 (add-to-history nil))
1536 (let* ((val (if (or (not (next-read-file-uses-dialog-p))
1537 (file-remote-p dir)) ; File dialogs can't handle remote files (Bug#99).
1538 ;; We used to pass DIR to `read-file-name-internal' by abusing arg
1539 ;; PREDICATE. It is better to just use `default-directory', but to avoid
1540 ;; changing `default-directory' in the current buffer, we do not
1541 ;; `let'-bind it.
1542 (let ((dir (file-name-as-directory (expand-file-name dir))))
1543 (minibuffer-with-setup-hook
1544 (lambda ()
1545 (setq default-directory dir)
1546 ;; When first default in `minibuffer-default' duplicates initial input
1547 ;; INSDEF, reset `minibuffer-default' to nil.
1548 (when (equal (or (car-safe insdef) insdef)
1549 (or (car-safe minibuffer-default) minibuffer-default))
1550 (setq minibuffer-default (cdr-safe minibuffer-default)))
1551 ;; Upon first `M-n' request, fill `minibuffer-default' with a list of
1552 ;; defaults relevant for file-name reading.
1553 (set (make-local-variable 'minibuffer-default-add-function)
1554 (lambda ()
1555 (with-current-buffer (window-buffer
1556 (minibuffer-selected-window))
1557 (read-file-name--defaults dir initial))))
1558 (set-syntax-table minibuffer-local-filename-syntax))
1559 (completing-read prompt 'read-file-name-internal pred mustmatch insdef
1560 history default-filename)))
1561 ;; If DEFAULT-FILENAME not supplied and DIR contains a file name, split it.
1562 (let ((file (file-name-nondirectory dir))
1563 ;; When using a dialog, revert to nil and non-nil interpretation of
1564 ;; MUSTMATCH. Confirmation options need to be interpreted as nil,
1565 ;; otherwise it is impossible to create new files using dialogs with
1566 ;; the default settings.
1567 (dialog-mustm (not (memq mustmatch
1568 '(nil confirm confirm-after-completion)))))
1569 (when (and (not default-filename) (not (zerop (length file))))
1570 (setq default-filename file
1571 dir (file-name-directory dir)))
1572 (when default-filename
1573 (setq default-filename (expand-file-name (if (consp default-filename)
1574 (car default-filename)
1575 default-filename)
1576 dir)))
1577 (setq add-to-history t)
1578 (x-file-dialog prompt dir default-filename dialog-mustm
1579 (eq predicate 'file-directory-p)))))
1580 (replace-in-history (eq (car-safe (symbol-value history)) val)))
1581 (setq history (symbol-value history))
1582 ;; If `completing-read' returned the inserted default string itself (rather than a new string with
1583 ;; the same contents), it has to mean that the user typed RET with the minibuffer empty.
1584 ;; In that case, we really want to return "" so that commands such as `set-visited-file-name' can
1585 ;; distinguish.
1586 (when (consp default-filename) (setq default-filename (car default-filename)))
1587 (when (eq val default-filename)
1588 ;; In this case, `completing-read' has not added an element to the history. Maybe we should.
1589 (unless replace-in-history (setq add-to-history t))
1590 (setq val ""))
1591 (unless val (error "No file name specified"))
1592 (when (and default-filename (string-equal val (if (consp insdef) (car insdef) insdef)))
1593 (setq val default-filename))
1594 (setq val (substitute-in-file-name val))
1595 (if replace-in-history
1596 ;; Replace what `Fcompleting_read' added to the history with what we will actually return.
1597 ;; As an exception, if that's the same as the second item in HISTORY, it's really a repeat
1598 ;; (Bug#4657).
1599 (let ((val1 (minibuffer--double-dollars val)))
1600 (when history-delete-duplicates
1601 (setcdr history (delete val1 (cdr history))))
1602 (if (string= val1 (cadr history))
1603 (pop history)
1604 (setcar history val1)))
1605 (when add-to-history
1606 ;; Add the value to HISTORY, unless it matches the last value already there.
1607 (let ((val1 (minibuffer--double-dollars val)))
1608 (unless (and (consp history) (equal (car history) val1))
1609 (setq history (cons val1 (if history-delete-duplicates (delete val1 history) history)))))))
1610 val))))
1611
1612 (defun icicle-fix-default-directory ()
1613 "Convert backslashes in `default-directory' to slashes."
1614 ;; This is a hack. If you do `C-x 4 f' from a standalone minibuffer
1615 ;; frame, `default-directory' on MS Windows has this form:
1616 ;; `C:\some-dir/'. There is a backslash character in the string. This
1617 ;; is not a problem for standard Emacs, but it is a problem for Icicles,
1618 ;; because we interpret backslashes using regexp syntax - they are not
1619 ;; file separators for Icicles. So, we call `substitute-in-file-name' to
1620 ;; change all backslashes in `default-directory' to slashes. This
1621 ;; shouldn't hurt, because `default-directory' is an absolute directory
1622 ;; name - it doesn't contain environment variables. For example, we
1623 ;; convert `C:\some-dir/' to `c:/some-directory/'."
1624 (setq default-directory (icicle-abbreviate-or-expand-file-name (substitute-in-file-name
1625 default-directory))))
1626
1627 (defun icicle-remove-property (prop plist)
1628 "Remove property PROP from property-list PLIST, non-destructively.
1629 Returns the modified copy of PLIST."
1630 (let ((cpy plist)
1631 (result ()))
1632 (while cpy
1633 (unless (eq prop (car cpy)) (setq result `(,(cadr cpy) ,(car cpy) ,@result)))
1634 (setq cpy (cddr cpy)))
1635 (nreverse result)))
1636
1637
1638 ;; REPLACE ORIGINAL `read-from-minibuffer' (built-in function),
1639 ;; saving it for restoration when you toggle `icicle-mode'.
1640 ;;
1641 ;; Respect `icicle-default-value'.
1642 ;;
1643 ;; We use HIST-m@%=!$+&^*z instead of HIST, to avoid name capture by `minibuffer-history-variable's
1644 ;; value. If we didn't need to be Emacs 20-compatible, then we could employ
1645 ;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
1646 ;;
1647 (unless (fboundp 'icicle-ORIG-read-from-minibuffer)
1648 (defalias 'icicle-ORIG-read-from-minibuffer (symbol-function 'read-from-minibuffer)))
1649
1650 (defun icicle-read-from-minibuffer (prompt &optional initial-contents keymap read
1651 hist-m@%=!$+&^*z default-value inherit-input-method)
1652 "Read a string from the minibuffer, prompting with string PROMPT.
1653 The optional second arg INITIAL-CONTENTS is an alternative to
1654 DEFAULT-VALUE. Vanilla Emacs considers it to be obsolete, but
1655 Icicles does not. It is discussed in more detail below.
1656
1657 Third arg KEYMAP is a keymap to use while reading;
1658 if omitted or nil, the default is `minibuffer-local-map'.
1659
1660 If fourth arg READ is non-nil, then interpret the result as a Lisp
1661 object and return that object. In other words, return this:
1662
1663 (car (read-from-string INPUT-STRING))
1664
1665 Fifth arg HIST, if non-nil, specifies a history list and optionally
1666 the initial position in the list. It can be a symbol, which is the
1667 history list variable to use, or it can be a cons cell
1668 (HISTVAR . HISTPOS). If a cons cell, HISTVAR is the history list
1669 variable to use and HISTPOS is the initial position for use by the
1670 minibuffer history commands. For consistency, you should also
1671 specify that element of the history as the value of
1672 INITIAL-CONTENTS. Positions are counted starting from 1 at the
1673 beginning of the list.
1674
1675 Sixth arg DEFAULT-VALUE is a string, nil, or (for Emacs 23 and later)
1676 a non-empty list of strings. The strings are available to the user
1677 as input via `\\<minibuffer-local-map>\\[next-history-element]'.
1678
1679 NOTE: Unlike a default-value parameter for some other functions such
1680 as `completing-read', if the user hits `RET' with empty input then
1681 DEFAULT-VALUE is NOT returned. In that case, if READ is nil then
1682 the empty string, \"\", is returned. If READ is non-nil then the
1683 DEFAULT-VALUE string (or the first string in DEFAULT-VALUE if
1684 DEFAULT-VALUE is a list) is read.
1685
1686 Seventh arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer
1687 inherits the current input method and the setting of
1688 `enable-multibyte-characters'.
1689
1690 If variable `minibuffer-allow-text-properties' is non-nil then the
1691 string returned includes whatever text properties were present in
1692 the minibuffer. Otherwise the return value has no text properties.
1693
1694 Option `icicle-default-value' controls how the default value,
1695 DEFAULT-VALUE, is treated.
1696
1697 The remainder of this documentation string describes parameter
1698 INITIAL-CONTENTS in more detail.
1699
1700 If non-nil, INITIAL-CONTENTS is a string to be inserted into the
1701 minibuffer before reading input. Normally, point is put at the end of
1702 that string. However, if INITIAL-CONTENTS is (STRING . POSITION), the
1703 initial input is STRING and point is placed at one-indexed position
1704 POSITION in the minibuffer. Any integer value less than or equal to
1705 one puts point at the beginning of the string. Note that this
1706 behavior differs from the way such arguments are used in
1707 `completing-read' and some other functions, which use zero-indexing
1708 for POSITION."
1709 (unless initial-contents (setq initial-contents ""))
1710
1711 ;; Filter DEFAULT-VALUE using `icicle-filter-wo-input'.
1712 (when default-value
1713 (setq default-value
1714 (if (atom default-value)
1715 (icicle-filter-wo-input default-value)
1716 (delq nil (mapcar #'icicle-filter-wo-input default-value))))) ; Emacs 23 accepts a list.
1717 ;; Save new default value for caller (e.g. `icicle-lisp-vanilla-completing-read'.
1718 (setq icicle-filtered-default-value default-value)
1719
1720 ;; If a list of strings, use the first one for prompt etc.
1721 (let ((def-value (icicle-unlist default-value)))
1722 ;; Maybe use DEFAULT-VALUE for INITIAL-CONTENTS also.
1723 (when (and icicle-default-value (not (eq icicle-default-value t))
1724 def-value (stringp initial-contents) (string= "" initial-contents))
1725 (setq initial-contents (if (integerp def-value) ; Character
1726 (string def-value)
1727 def-value)))
1728 ;;; $$$$$$ (when (and def-value (eq icicle-default-value t)) ; Add DEFAULT-VALUE to PROMPT.
1729 ;;; (when (icicle-file-name-input-p) (setq def-value (file-name-nondirectory def-value)))
1730 ;;; (setq prompt (if (string-match "\\(.*\\)\\(: *\\)$" prompt)
1731 ;;; (concat (substring prompt (match-beginning 1) (match-end 1)) " (" def-value
1732 ;;; ")" (substring prompt (match-beginning 2) (match-end 2)))
1733 ;;; (concat prompt def-value))))
1734 )
1735 (icicle-ORIG-read-from-minibuffer
1736 prompt initial-contents keymap read hist-m@%=!$+&^*z default-value inherit-input-method))
1737
1738
1739 ;; REPLACE ORIGINAL `minibuffer-default-add-completions' defined in `simple.el',
1740 ;; saving it for restoration when you toggle `icicle-mode'.
1741 ;;
1742 ;; Respect Icicles global filters, so you don't see, as defaults, candidates that were filtered out.
1743 ;;
1744 (when (fboundp 'minibuffer-default-add-completions) ; Emacs 23+.
1745 (unless (fboundp 'icicle-ORIG-minibuffer-default-add-completions)
1746 (defalias 'icicle-ORIG-minibuffer-default-add-completions
1747 (symbol-function 'minibuffer-default-add-completions)))
1748
1749 ;; Use this as `minibuffer-default-add-function'.
1750 (defun icicle-minibuffer-default-add-completions ()
1751 "Like `icicle-ORIG-minibuffer-default-add-completions', but respect global filters."
1752 (let ((def minibuffer-default)
1753 (all (icicle-all-completions "" minibuffer-completion-table
1754 minibuffer-completion-predicate 'HIDE-SPACES)))
1755 (setq all (icicle-remove-if-not (lambda (cand)
1756 (let ((case-fold-search completion-ignore-case))
1757 (icicle-filter-wo-input cand)))
1758 all))
1759 (if (listp def) (append def all) (cons def (delete def all))))))
1760
1761
1762 ;; REPLACE ORIGINAL `read-buffer' (built-in).
1763 ;;
1764 ;; 1. Interactively, uses `another-buffer' or `other-buffer' if no default.
1765 ;; 2. Emacs 23+ compatible: handles `read-buffer-function'
1766 ;; and `read-buffer-completion-ignore-case'.
1767 ;; 3. Respects `icicle-buffer-ignore-space-prefix-flag'.
1768 ;;
1769 (unless (fboundp 'icicle-ORIG-read-buffer)
1770 (defalias 'icicle-ORIG-read-buffer (symbol-function 'read-buffer)))
1771
1772 (defun icicle-read-buffer (prompt &optional default require-match)
1773 "Read the name of a buffer and return it as a string.
1774 Prompt with first arg, PROMPT (a string).
1775
1776 If user input is empty (just `RET') then return the default value,
1777 which is:
1778 - optional second arg DEFAULT, if non-nil
1779 - `another-buffer' or `other-buffer', otherwise.
1780
1781 If `another-buffer' is undefined, then use `other-buffer'.
1782
1783 Starting with Emacs 23, DEFAULT can be a list of names (strings), in
1784 which case the first name in the list is returned on empty input.
1785
1786 Non-nil REQUIRE-MATCH means to allow only names of existing buffers.
1787 It is the same as for `completing-read'.
1788
1789 Case sensitivity is determined by
1790 `read-buffer-completion-ignore-case', if defined, or
1791 `completion-ignore-case' otherwise.
1792
1793 This binds variable `icicle-buffer-name-input-p' to non-nil."
1794 (let ((icicle-buffer-name-input-p t))
1795 (if (and (boundp 'read-buffer-function) read-buffer-function)
1796 (funcall read-buffer-function prompt default require-match)
1797 (when (interactive-p)
1798 (setq default (or default (if (fboundp 'another-buffer) ; In `misc-fns.el'.
1799 (another-buffer nil t)
1800 (other-buffer (current-buffer))))))
1801 (when (bufferp default) (setq default (buffer-name default))) ; Need a string as default.
1802 (let ((completion-ignore-case (if (boundp 'read-buffer-completion-ignore-case)
1803 read-buffer-completion-ignore-case
1804 completion-ignore-case)))
1805 (completing-read prompt
1806 (cond ((and (eq icicle-buffer-complete-fn 'internal-complete-buffer)
1807 icicle-buffer-ignore-space-prefix-flag)
1808 'internal-complete-buffer) ; Emacs 22+
1809 (icicle-buffer-complete-fn)
1810 (t
1811 (mapcar (lambda (buf) (and (buffer-live-p buf) (list (buffer-name buf))))
1812 (buffer-list))))
1813 nil require-match nil 'buffer-name-history default nil)))))
1814
1815
1816 ;; REPLACE ORIGINAL `read-number' defined in `subr.el',
1817 ;; saving it for restoration when you toggle `icicle-mode'.
1818 ;; 1. Let user enter a numeric variable name, for its value. Allow completion.
1819 ;; 2. Allow for error reading input.
1820 ;; 3. Call `ding' if not a number, and don't redisplay for `sit-for'.
1821 ;;
1822 (when (fboundp 'read-number) ; Emacs 22+
1823 (unless (fboundp 'icicle-ORIG-read-number)
1824 (defalias 'icicle-ORIG-read-number (symbol-function 'read-number)))
1825
1826 (defun icicle-read-number (prompt &optional default)
1827 "Read a number in the minibuffer, prompting with PROMPT (a string).
1828 DEFAULT is returned if the user hits `RET' without typing anything.
1829
1830 If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
1831 also enter the name of a numeric variable - its value is returned.
1832 Completion is available for this. A numeric variable is a variable
1833 whose value or whose custom type is compatible with type `integer',
1834 `number', or `float'."
1835 (unwind-protect
1836 (let ((num nil)
1837 (icicle-proxy-candidates
1838 (append
1839 (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
1840 (let ((ipc ()))
1841 (mapatoms
1842 (lambda (cand)
1843 (when (and (user-variable-p cand)
1844 (condition-case nil
1845 (icicle-var-is-of-type-p cand (if (>= emacs-major-version 22)
1846 '(number integer float)
1847 '(number integer)))
1848 (error nil)))
1849 (push (symbol-name cand) ipc))))
1850 ipc))
1851 icicle-proxy-candidates))
1852
1853 ;; Emacs 23 allows DEFAULT to be a list of strings - use the first one for prompt etc.
1854 (default1 (if (atom default) default (setq default (delq nil default)) (car default))))
1855 (when default
1856 (save-match-data
1857 (setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt)
1858 (replace-match (format " (default %s)" default1) t t prompt 1)
1859 (replace-regexp-in-string
1860 "[ \t]*\\'" (format " (default %s) " default1) prompt t t)))))
1861 (when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
1862 (while (progn
1863 (let ((str (completing-read prompt nil nil nil nil nil
1864 (if (consp default)
1865 (mapcar #'number-to-string default)
1866 (and default1 (number-to-string default1)))))
1867 temp)
1868 (setq num (cond ((zerop (length str)) default1)
1869 ((setq temp (member str icicle-proxy-candidates))
1870 (symbol-value (intern (car temp))))
1871 ((stringp str) (condition-case nil (read str) (error nil))))))
1872 (unless (numberp num)
1873 (icicle-ding) (message "Not a number. Try again.") (sit-for 0.5 nil t)
1874 t)))
1875 num)
1876 ;; Because we do this here, if a command that uses `icicle-read-number' needs the proxies
1877 ;; afterward then it needs to save a copy of them.
1878 (setq icicle-proxy-candidates ()))))
1879
1880 ;; Can't replace standard `read-char-exclusive' with this, because, starting with Emacs 22, it has
1881 ;; an optional SECONDS arg that cannot be simulated using `completing-read'.
1882 (defun icicle-read-char-exclusive (prompt &optional inherit-input-method)
1883 "Read a character in the minibuffer, prompting with PROMPT (a string).
1884 It is returned as a number.
1885 Optional arg INHERIT-INPUT-METHOD is as for `completing-read'.
1886
1887 If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
1888 also enter the name of a character variable - its value is returned.
1889 Completion is available for this. A character variable is a variable
1890 whose value is compatible with type `character'."
1891 (unwind-protect
1892 (let* ((char nil)
1893 (icicle-proxy-candidates
1894 (append (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
1895 (let ((ipc ()))
1896 (mapatoms (lambda (cand)
1897 (when (and (user-variable-p cand)
1898 (condition-case nil
1899 (icicle-var-is-of-type-p cand '(character))
1900 (error nil)))
1901 (push (symbol-name cand) ipc))))
1902 ipc))
1903 icicle-proxy-candidates))
1904 str temp)
1905 (when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
1906 (setq str (completing-read prompt nil nil nil nil nil nil inherit-input-method)
1907 char (cond ((zerop (length str)) (error "No character read"))
1908 ((setq temp (member str icicle-proxy-candidates))
1909 (symbol-value (intern (car temp))))
1910 ((stringp str) (condition-case nil
1911 (progn (when (> (length str) 1)
1912 (message "First char is used: `%c'"
1913 (elt str 0)) (sit-for 2))
1914 (elt str 0))
1915 (error nil)))))
1916 char)
1917 ;; Because we do this here, if a command that uses `icicle-read-char-exclusive' needs the proxies
1918 ;; afterward then it needs to save a copy of them.
1919 (setq icicle-proxy-candidates ())))
1920
1921 ;; Not used in Icicles code, but used by other libraries.
1922 (defun icicle-read-string-completing (prompt &optional default pred hist)
1923 "Read a string in the minibuffer, prompting with PROMPT (a string).
1924 If the user hits `RET' without typing anything, return DEFAULT, or \"\"
1925 if DEFAULT is nil.
1926 PRED is a predicate that filters the variables available for completion.
1927 HIST is the history list to use, as for `completing-read'.
1928
1929 If option `icicle-add-proxy-candidates-flag' is non-nil, the user can
1930 also enter the name of a string variable - its value is returned.
1931 Completion is available for this. A string variable is a variable
1932 whose value or whose custom type is compatible with type `string'."
1933 (unwind-protect
1934 (let ((strg nil)
1935 (default1 (icicle-unlist default)) ; Emacs 23+ lets DEFAULT be a list of strings - use the first.
1936 (icicle-proxy-candidates
1937 (append
1938 (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
1939 (let ((ipc ()))
1940 (mapatoms (lambda (cand)
1941 (when (and (user-variable-p cand)
1942 (condition-case nil
1943 (icicle-var-is-of-type-p cand '(string color regexp))
1944 (error nil)))
1945 (push (symbol-name cand) ipc))))
1946 ipc))
1947 icicle-proxy-candidates)))
1948 (when default
1949 (save-match-data
1950 (setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt)
1951 (replace-match (format " (default %s)" default1) t t prompt 1)
1952 (replace-regexp-in-string
1953 "[ \t]*\\'" (format " (default %s) " default1) prompt t t)))))
1954 (when icicle-proxy-candidates (put-text-property 0 1 'icicle-fancy-candidates t prompt))
1955 (let ((strg-read (completing-read prompt nil pred nil
1956 (and (consp hist) (nth (cdr hist) (symbol-value (car hist))))
1957 hist default))
1958 temp)
1959 (setq strg (cond ((zerop (length strg-read)) (or default1 ""))
1960 ((setq temp (member strg-read icicle-proxy-candidates))
1961 (setq temp (symbol-value (intern (car temp))))
1962 (cond ((and (symbolp hist) (consp (symbol-value hist)))
1963 (setcar (symbol-value hist) temp))
1964 ((and (consp hist) (symbolp (car hist))
1965 (consp (symbol-value (car hist))))
1966 (setcar (symbol-value (car hist)) temp)))
1967 temp)
1968 (t strg-read))))
1969 strg)
1970 ;; Because we do this here, if a command that uses `icicle-read-string-completing' needs the proxies
1971 ;; afterward then it needs to save a copy of them.
1972 (setq icicle-proxy-candidates ())))
1973
1974 ;; Same as `help-var-is-of-type-p'.
1975 (defun icicle-var-is-of-type-p (variable types &optional mode)
1976 "Return non-nil if VARIABLE satisfies one of the custom types in TYPES.
1977 TYPES is a list of `defcustom' type sexps or a list of regexp strings.
1978 TYPES are matched, in order, against VARIABLE's type definition or
1979 VARIABLE's current value, until one is satisfied or all are tried.
1980
1981 If TYPES is a list of regexps, then each is regexp-matched against
1982 VARIABLE's custom type.
1983
1984 Otherwise, TYPES is a list of type sexps, each of which is a
1985 definition acceptable for `defcustom' :type or the first symbol of
1986 such a definition (e.g. `choice'). In this case, two kinds of type
1987 comparison are possible:
1988
1989 1. VARIABLE's custom type, or its first symbol, is matched using
1990 `equal' against each type in TYPES.
1991
1992 2. VARIABLE's current value is checked against each type in TYPES to
1993 see if it satisfies one of them. In this case, VARIABLE's own type
1994 is not used; VARIABLE might not even be typed - it could be a
1995 variable not defined using `defcustom'.
1996
1997 For any of the comparisons against VARIABLE's type, either that type
1998 can be checked directly or its supertypes (inherited types) can also
1999 be checked.
2000
2001 These different type-checking possibilities depend on the value of
2002 argument MODE, as follows, and they determine the meaning of the
2003 returned value:
2004
2005 `direct': VARIABLE's type matches a member of list TYPES
2006 `inherit': VARIABLE's type matches or is a subtype of a TYPES member
2007 `value': VARIABLE is bound, and its value satisfies a type in TYPES
2008 `inherit-or-value': `inherit' or `value', tested in that order
2009 `direct-or-value': `direct' or `value', tested in that order
2010 anything else (default): `inherit'
2011
2012 VARIABLE's current value cannot satisfy a regexp type: it is
2013 impossible to know which concrete types a value must match."
2014 (case mode
2015 ((nil inherit) (icicle-var-inherits-type-p variable types))
2016 (inherit-or-value (or (icicle-var-inherits-type-p variable types)
2017 (icicle-var-val-satisfies-type-p variable types)))
2018 (value (icicle-var-val-satisfies-type-p variable types))
2019 (direct (icicle-var-matches-type-p variable types))
2020 (direct-or-value (or (member (icicle-get-safe variable 'custom-type) types)
2021 (icicle-var-val-satisfies-type-p variable types)))
2022 (otherwise (icicle-var-inherits-type-p variable types))))
2023
2024 (defun icicle-var-matches-type-p (variable types)
2025 "VARIABLE's type matches a member of TYPES."
2026 (catch 'icicle-type-matches
2027 (let ((var-type (icicle-get-safe variable 'custom-type)))
2028 (dolist (type types)
2029 (when (if (stringp type)
2030 (save-match-data (string-match type (format "%s" (format "%S" var-type))))
2031 (equal var-type type))
2032 (throw 'icicle-type-matches t))))
2033 nil))
2034
2035 (defun icicle-var-inherits-type-p (variable types)
2036 "VARIABLE's type matches or is a subtype of a member of list TYPES."
2037 (catch 'icicle-type-inherits
2038 (let ((var-type (icicle-get-safe variable 'custom-type)))
2039 (dolist (type types)
2040 (while var-type
2041 (when (or (and (stringp type)
2042 (save-match-data (string-match type (format "%s" (format "%S" var-type)))))
2043 (equal type var-type))
2044 (throw 'icicle-type-inherits t))
2045 (when (consp var-type) (setq var-type (car var-type)))
2046 (when (or (and (stringp type)
2047 (save-match-data (string-match type (format "%s" (format "%S" var-type)))))
2048 (equal type var-type))
2049 (throw 'icicle-type-inherits t))
2050 (setq var-type (car (icicle-get-safe var-type 'widget-type))))
2051 (setq var-type (icicle-get-safe variable 'custom-type))))
2052 nil))
2053
2054 (defun icicle-var-val-satisfies-type-p (variable types)
2055 "VARIABLE is bound, and its value satisfies a type in the list TYPES."
2056 (and (boundp variable)
2057 (let ((val (symbol-value variable)))
2058 (and (widget-convert (icicle-get-safe variable 'custom-type))
2059 (icicle-value-satisfies-type-p val types)))))
2060
2061 (defun icicle-value-satisfies-type-p (value types)
2062 "Return non-nil if VALUE satisfies a type in the list TYPES."
2063 (catch 'icicle-type-value-satisfies
2064 (dolist (type types)
2065 (unless (stringp type) ; Skip, for regexp type.
2066 (setq type (widget-convert type))
2067 ;; Satisfies if either :match or :validate.
2068 (when (condition-case nil
2069 (progn (when (and (widget-get type :match) (widget-apply type :match value))
2070 (throw 'icicle-type-value-satisfies t))
2071 (when (and (widget-get type :validate)
2072 (progn (widget-put type :value value)
2073 (not (widget-apply type :validate))))
2074 (throw 'icicle-type-value-satisfies t)))
2075 (error nil))
2076 (throw 'icicle-type-value-satisfies t))))
2077 nil))
2078
2079 (defun icicle-custom-type (variable)
2080 "Returns the `defcustom' type of VARIABLE.
2081 Returns nil if VARIABLE is not a user option.
2082
2083 Note: If the library that defines VARIABLE has not yet been loaded,
2084 then `icicle-custom-type' loads it. Be sure you want to do that
2085 before you call this function."
2086 (and (custom-variable-p variable)
2087 (or (get variable 'custom-type)
2088 (progn (custom-load-symbol variable) (get variable 'custom-type)))))
2089
2090 (when (fboundp 'read-char-by-name) ; Emacs 23+
2091 (defun icicle-read-char-maybe-completing (&optional prompt names inherit-input-method seconds)
2092 "Read a char with PROMPT, possibly completing against NAMES.
2093 If the character read is `C-q' then read another character.
2094 Otherwise, if the character read is a completing key (e.g. `TAB'),
2095 then complete.
2096
2097 Elements of alist NAMES have the form of `ucs-names' elements:
2098 (CHAR-NAME . CHAR-CODE)
2099 NAMES defaults to the subset of `ucs-names' that corresponds to the
2100 characters that have been read previously.
2101 The other arguments are as in `read-char-by-name'."
2102 (unless names (setq names (or (icicle-char-cands-from-charlist) (icicle-ucs-names))))
2103 (let ((chr (read-char prompt inherit-input-method seconds)))
2104 (if (eq chr ?\C-q)
2105 (setq chr (read-char prompt inherit-input-method seconds)) ; ^Q - read next
2106 (when (member (vector chr) (append icicle-prefix-complete-keys icicle-apropos-complete-keys))
2107 (add-to-list 'unread-command-events chr)
2108 (setq chr (icicle-read-char-by-name prompt names))))
2109 chr))
2110
2111 (defun icicle-char-cands-from-charlist (&optional chars)
2112 "Characters in list CHARS that are listed in `icicle-ucs-names'.
2113 CHARS defaults to the value of `icicle-read-char-history'."
2114 (unless chars (setq chars icicle-read-char-history))
2115 (let ((cands ())
2116 name.char)
2117 (dolist (char chars)
2118 (when (setq name.char (rassq char (icicle-ucs-names)))
2119 (push name.char cands)))
2120 cands)))
2121
2122
2123 ;; REPLACE ORIGINAL `read-char-by-name' in `mule-cmds.el' (Emacs 23+).
2124 ;; saving it for restoration when you toggle `icicle-mode'.
2125 ;;
2126 ;; 1. Use `icicle-ucs-names', not `ucs-names'.
2127 ;; 2. Exclude character names "" and "VARIATION SELECTOR*".
2128 ;; 3. Display the character itself, after its name, in `*Completions*'.
2129 ;; 4. Added optional arg NAMES.
2130 ;; 5. Add char read to `icicle-read-char-history'.
2131 ;; 5. See doc string for the rest.
2132 ;;
2133 (when (fboundp 'read-char-by-name) ; Emacs 23+
2134
2135 (defun icicle-make-char-candidate (name.char)
2136 "Return multi-completion candidate for NAME.CHAR.
2137 NAME.CHAR has the form of an element of `ucs-names':
2138 * The car is the character name.
2139 * The cdr is the character itself.
2140
2141 The multi-completion candidate is a cons whose cdr is still the
2142 character, but whose car is a list (NAME CODE SCHAR), where:
2143 * CODE is a string representation of the Unicode code point of CHAR,
2144 as a hexidecimal numeral
2145 * SCHAR is a string representation of CHAR
2146
2147 Properties `help-echo' and `icicle-mode-line-help' are put on NAME,
2148 showing both NAME and the code point (in hex, octal, and decimal)."
2149 (and (not (string= "" (car name.char)))
2150 ;; $$$$$$ Maybe make this optional?
2151 ;; (not (string-match "\\`VARIATION SELECTOR" (car name.char))))
2152 (let* ((name (copy-sequence (car name.char)))
2153 (char (cdr name.char)))
2154 (icicle-candidate-short-help (format "Char: %-10cCode Point: x%X, o%o, %d" char char char char) name)
2155 (cons (list name (format "%X" char) (format "%c" char)) char))))
2156
2157
2158
2159 (unless (fboundp 'icicle-ORIG-read-char-by-name)
2160 (defalias 'icicle-ORIG-read-char-by-name (symbol-function 'read-char-by-name)))
2161
2162 (defun icicle-read-char-by-name (prompt &optional names)
2163 "Read a character by its Unicode name or hex number string.
2164 Display PROMPT and read a string that represents a character by its
2165 Unicode property `name' or `old-name'. Return the char as a number.
2166
2167 You can use completion against the Unicode name of the character.
2168
2169 In Icicle mode:
2170
2171 * The Unicode code point of the char and the char itself appear next
2172 to the char name in `*Completions*' - WYSIWYG.
2173
2174 * The completion candidate is a multi-completion. Its first part is
2175 the char name. Its second part is the code point, as a hexadecimal
2176 numeral. Its third part is the character. This means that you can
2177 alternatively type the code point or the character to see what the
2178 name is. You can complete the name or the code point, or both.
2179
2180 * When you cycle among candidates, regardless of whether buffer
2181 `*Completions*' is shown, the current character and its code point
2182 are shown in the mode line (provided user option
2183 `icicle-help-in-mode-line-delay' is greater than zero). The code
2184 point is shown in hexadecimal, octal, and decimal notation.
2185
2186 If you use a dedicated `*Completions*' frame, then the font used in
2187 `*Completions*' is the same as the frame from which you invoked
2188 completion.
2189
2190 If you use library `doremi-frm.el' then you can increase the font size
2191 for `*Completions*' dynamically using `C-x -'.
2192
2193 As an alternative to completing the Unicode name or code point, you
2194 can just input the code point as a hexidecimal numeral or a number in
2195 hash notation: #o21430 for octal, #x2318 for hex, or #10r8984 for
2196 decimal.
2197
2198 Non-nil optional arg NAMES is an alist of names to use in place of the
2199 value returned by `icicle-ucs-names'. It must have the same form as
2200 such a return value: (CHAR-NAME . CHAR-CODE)."
2201 (unless names (setq names (icicle-ucs-names)))
2202 (setq names (delq nil (mapcar #'icicle-make-char-candidate names)))
2203 (let* ((new-prompt (copy-sequence prompt))
2204 (enable-recursive-minibuffers t)
2205 (completion-ignore-case t)
2206 (icicle-show-multi-completion-flag t) ; Override user setting.
2207 (icicle-multi-completing-p t)
2208 (icicle-list-use-nth-parts '(1))
2209 (icicle-transform-before-sort-p t)
2210 (icicle-list-join-string "\t")
2211 (icicle-candidate-properties-alist '((3 (face icicle-candidate-part))))
2212 (icicle-whole-candidate-as-text-prop-p t)
2213 (mctized-cands (car (icicle-mctize-all names nil)))
2214 (collection-fn `(lambda (string pred action)
2215 (if (eq action 'metadata)
2216 '(metadata (category . unicode-name))
2217 (complete-with-action
2218 action ',mctized-cands string pred))))
2219 (input (completing-read new-prompt collection-fn))
2220 chr)
2221 (setq chr (cond ((string-match-p "\\`[0-9a-fA-F]+\\'" input) (string-to-number input 16))
2222 ((string-match-p "^#" input) (read input))
2223 ((cddr (assoc-string input mctized-cands t))) ; INPUT is a multi-completion.
2224 (t
2225 (let ((completion (try-completion input collection-fn)))
2226 (and (stringp completion)
2227 ;; INPUT is not a multi-completion, but it may match a single sulti-completion.
2228 ;; In particular, it might match just the NAME or CODE part of it.
2229 (let* ((name (icicle-transform-multi-completion
2230 completion))
2231 (icicle-list-use-nth-parts '(2))
2232 (code (icicle-transform-multi-completion
2233 completion))
2234 ;; To have property `icicle-whole-candidate', COMPLETION must be complete.
2235 (char (cdr
2236 (get-text-property
2237 0 'icicle-whole-candidate completion)))
2238 (case-fold-search t))
2239 (and (or (and name (string-match-p input name))
2240 (and code (string-match-p input code)))
2241 char)))))))
2242 (unless (characterp chr) (error "Invalid character: `%s'" input))
2243 (add-to-list 'icicle-read-char-history chr)
2244 chr))
2245
2246 ;; This would not be needed if there were not Emacs bug #9653.
2247 (defun icicle-ucs-names ()
2248 "Same as `ucs-names', except remove entries with an empty name: \"\"."
2249 (setq ucs-names (assq-delete-all "" (ucs-names))))) ; Free var here: `ucs-names'.
2250
2251
2252 ;; REPLACE ORIGINAL `read-string' (built-in function),
2253 ;; saving it for restoration when you toggle `icicle-mode'.
2254 ;;
2255 ;; Respect `icicle-default-value' (via use of `read-from-minibuffer').
2256 ;;
2257 ;; We use HIST-m@%=!$+&^*z instead of HISTORY, to avoid name capture by `minibuffer-history-variable's
2258 ;; value. If we didn't need to be Emacs 20-compatible, then we could employ
2259 ;; `#1=#:hist'...`#1#'...`#1' read syntax to use an uninterned symbol.
2260 ;;
2261 (unless (fboundp 'icicle-ORIG-read-string)
2262 (defalias 'icicle-ORIG-read-string (symbol-function 'read-string)))
2263
2264 (defun icicle-read-string (prompt &optional initial-input hist-m@%=!$+&^*z
2265 default-value inherit-input-method)
2266 "Read a string from the minibuffer, prompting with string PROMPT.
2267 If non-nil, second arg INITIAL-INPUT is a string to insert before reading.
2268 Vanilla Emacs considers it to be obsolete, but Icicles does not. It
2269 behaves like argument INITIAL-CONTENTS in `read-from-minibuffer'.
2270 See the documentation string of `read-from-minibuffer' for details.
2271 The third arg HISTORY, if non-nil, specifies a history list
2272 and optionally the initial position in the list.
2273 See `read-from-minibuffer' for details of HISTORY argument.
2274 Fourth arg DEFAULT-VALUE is the default value. If non-nil, it is used
2275 for history commands, and as the value to return if the user enters
2276 the empty string.
2277 Fifth arg INHERIT-INPUT-METHOD, if non-nil, means the minibuffer inherits
2278 the current input method and the setting of enable-multibyte-characters."
2279 (when default-value
2280 (setq prompt (icicle-handle-default-for-prompt prompt default-value 'INCLUDE)))
2281 (let ((value (read-from-minibuffer prompt initial-input nil nil hist-m@%=!$+&^*z
2282 default-value inherit-input-method)))
2283 (when (and default-value (equal value ""))
2284 (setq value (icicle-unlist default-value)))
2285 value))
2286
2287
2288 ;; REPLACE ORIGINAL `read-face-name' in `faces.el',
2289 ;; saving it for restoration when you toggle `icicle-mode'.
2290 ;;
2291 ;; Show face names in `*Completions*' with the faces they name.
2292 ;;
2293 (unless (fboundp 'icicle-ORIG-read-face-name)
2294 (defalias 'icicle-ORIG-read-face-name (symbol-function 'read-face-name)))
2295
2296 (cond ((< emacs-major-version 21)
2297 (defun icicle-read-face-name (prompt) ; Emacs 20
2298 "Read a face name with completion and return its face symbol.
2299 PROMPT is the prompt.
2300
2301 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
2302 also enter the name of a face-name variable - its value is returned.
2303 A face-name variable is a variable with custom-type `face'.
2304
2305 If library `eyedropper.el' is used, then you can also choose proxy
2306 candidate `*point face name*' to use the face at point."
2307 (require 'eyedropper nil t)
2308 (let ((icicle-multi-completing-p t)
2309 (icicle-list-nth-parts-join-string ": ")
2310 (icicle-list-join-string ": ")
2311 (icicle-list-use-nth-parts '(1))
2312 (icicle-proxy-candidates
2313 (append
2314 (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
2315 (append (and (fboundp 'eyedrop-face-at-point) (list "*point face name*"))
2316 (let ((ipc ()))
2317 (mapatoms
2318 (lambda (cand)
2319 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
2320 (push `,(concat "'" (symbol-name cand) "'") ipc))))
2321 ipc)))
2322 icicle-proxy-candidates))
2323 face)
2324 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
2325 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
2326 (while (= (length face) 0)
2327 (setq face (icicle-transform-multi-completion
2328 (completing-read prompt (mapcar #'icicle-make-face-candidate (face-list))
2329 nil (not (stringp icicle-WYSIWYG-Completions-flag)) nil
2330 (if (boundp 'face-name-history)
2331 'face-name-history
2332 'icicle-face-name-history)))))
2333 (let ((proxy (car (member face icicle-proxy-candidates))))
2334 (cond ((save-match-data (string-match "*point face name\\*$" face))
2335 (eyedrop-face-at-point))
2336 (proxy (symbol-value (intern (substring proxy 1 (1- (length proxy))))))
2337 (t (intern face)))))))
2338
2339 ((= emacs-major-version 21) ; Emacs 21
2340 (defun icicle-read-face-name (prompt)
2341 "Read a face name with completion and return its face symbol.
2342 PROMPT is the prompt.
2343
2344 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
2345 also enter the name of a face-name variable - its value is returned.
2346 A face-name variable is a variable with custom-type `face'.
2347
2348 If library `eyedropper.el' is used, then you can also choose proxy
2349 candidate `*point face name*' to use the face at point."
2350 (require 'eyedropper nil t)
2351 (let ((icicle-multi-completing-p t)
2352 (icicle-list-nth-parts-join-string ": ")
2353 (icicle-list-join-string ": ")
2354 (icicle-list-use-nth-parts '(1))
2355 (icicle-proxy-candidates
2356 (append
2357 (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
2358 (append (and (fboundp 'eyedrop-face-at-point) (list "*point face name*"))
2359 (let ((ipc ()))
2360 (mapatoms
2361 (lambda (cand)
2362 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
2363 (push `,(concat "'" (symbol-name cand) "'") ipc))))
2364 ipc)))
2365 icicle-proxy-candidates))
2366 (face-list (face-list))
2367 (def (icicle-thing-at-point 'symbol))
2368 face)
2369 (cond ((assoc def face-list) (setq prompt (concat prompt " (default " def "): ")))
2370 (t (setq def nil
2371 prompt (concat prompt ": "))))
2372 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
2373 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
2374 (while (equal "" (setq face (icicle-transform-multi-completion
2375 (completing-read
2376 prompt (mapcar #'icicle-make-face-candidate face-list) nil
2377 (not (stringp icicle-WYSIWYG-Completions-flag)) nil
2378 (if (boundp 'face-name-history)
2379 'face-name-history
2380 'icicle-face-name-history)
2381 def)))))
2382 (let ((proxy (car (member face icicle-proxy-candidates))))
2383 (cond ((save-match-data (string-match "*point face name\\*$" face))
2384 (eyedrop-face-at-point))
2385 (proxy (symbol-value (intern (substring proxy 1 (1- (length proxy))))))
2386 (t (intern face)))))))
2387
2388 ((< emacs-major-version 24) ; Emacs 22-23
2389 (defun icicle-read-face-name (prompt &optional string-describing-default multiple)
2390 "Read a face name with completion and return its face symbol
2391 By default, use the face(s) on the character after point. If that
2392 character has the property `read-face-name', that overrides the `face'
2393 property.
2394
2395 PROMPT should be a string that describes what the caller will do with the face;
2396 it should not end in a space.
2397 STRING-DESCRIBING-DEFAULT should describe what default the caller will use if
2398 the user just types RET; you can omit it.
2399 If MULTIPLE is non-nil, return a list of faces (possibly only one).
2400 Otherwise, return a single face.
2401
2402 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
2403 also enter the name of a face-name variable - its value is returned.
2404 A face-name variable is a variable with custom-type `face'.
2405
2406 If library `palette.el' or `eyedropper.el' is used, then you can also
2407 choose proxy candidate `*point face name*' to use the face at point."
2408 (or (require 'palette nil t) (require 'eyedropper nil t))
2409 (let ((faceprop (or (get-char-property (point) 'read-face-name)
2410 (get-char-property (point) 'face)))
2411 (aliasfaces ())
2412 (nonaliasfaces ())
2413 (icicle-proxy-candidates
2414 (append (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
2415 (let ((ipc ()))
2416 (mapatoms
2417 (lambda (cand)
2418 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
2419 (push `,(concat "'" (symbol-name cand) "'") ipc))))
2420 ipc))
2421 icicle-proxy-candidates))
2422 faces)
2423 (save-match-data ; Undo Emacs 22+ brain-dead treatment of PROMPT arg.
2424 (when (string-match "\\(:\\s *$\\|:?\\s +$\\)" prompt)
2425 (setq prompt (substring prompt 0 (- (length (match-string 0 prompt)))))))
2426 ;; Try to get a face name from the buffer.
2427 (when (memq (intern-soft (icicle-thing-at-point 'symbol)) (face-list))
2428 (setq faces (list (intern-soft (icicle-thing-at-point 'symbol)))))
2429 ;; Add the named faces that the `face' property uses.
2430 (if (and (consp faceprop)
2431 ;; Don't treat an attribute spec as a list of faces.
2432 (not (keywordp (car faceprop)))
2433 (not (memq (car faceprop) '(foreground-color background-color))))
2434 (dolist (f faceprop) (when (symbolp f) (push f faces)))
2435 (when (and faceprop (symbolp faceprop)) (push faceprop faces)))
2436 (delete-dups faces)
2437 (cond (multiple
2438 ;; We leave this branch as it is. Icicles does nothing special with
2439 ;; `completing-read-multiple'.
2440 (require 'crm)
2441 (mapatoms (lambda (symb) (when (custom-facep symb) ; Build up the completion tables.
2442 (if (get symb 'face-alias)
2443 (push (symbol-name symb) aliasfaces)
2444 (push (symbol-name symb) nonaliasfaces)))))
2445 (let* ((input (completing-read-multiple ; Read the input.
2446 (if (or faces string-describing-default)
2447 (format "%s (default %s): "
2448 prompt (if faces
2449 (mapconcat 'symbol-name faces ",")
2450 string-describing-default))
2451 (format "%s: " prompt))
2452 ;; This lambda expression is the expansion of Emacs 22 macro
2453 ;; (complete-in-turn nonaliasfaces aliasfaces). We expand it so
2454 ;; this can be compiled also in Emacs < 22 to work for Emacs 22.
2455 (lambda (string predicate mode)
2456 (cond ((eq mode t)
2457 (or (all-completions string nonaliasfaces predicate)
2458 (all-completions string aliasfaces predicate)))
2459 ((eq mode nil)
2460 (or (try-completion string nonaliasfaces predicate)
2461 (try-completion string aliasfaces predicate)))
2462 (t
2463 (or (test-completion string nonaliasfaces predicate)
2464 (test-completion string aliasfaces predicate)))))
2465 nil t nil (if (boundp 'face-name-history)
2466 'face-name-history
2467 'icicle-face-name-history)
2468 (and faces (mapconcat 'symbol-name faces ","))))
2469 (output (cond ((or (equal input "") (equal input '(""))) ; Canonicalize.
2470 faces)
2471 ((stringp input)
2472 (mapcar 'intern (split-string input ", *" t)))
2473 ((listp input)
2474 (mapcar 'intern input))
2475 (input))))
2476 output)) ; Return the list of faces
2477 (t
2478 (when (consp faces) (setq faces (list (car faces))))
2479 (let ((icicle-multi-completing-p t)
2480 (icicle-list-nth-parts-join-string ": ")
2481 (icicle-list-join-string ": ")
2482 (icicle-list-use-nth-parts '(1))
2483 (face-list (face-list))
2484 (def (if faces
2485 (mapconcat 'symbol-name faces ",")
2486 string-describing-default))
2487 face)
2488 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
2489 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
2490 (while (equal "" (setq face (icicle-transform-multi-completion
2491 (completing-read
2492 (if def
2493 (format "%s (default %s): " prompt def)
2494 (format "%s: " prompt))
2495 (mapcar #'icicle-make-face-candidate face-list)
2496 nil (not (stringp icicle-WYSIWYG-Completions-flag))
2497 nil (if (boundp 'face-name-history)
2498 'face-name-history
2499 'icicle-face-name-history)
2500 def)))))
2501 (let ((proxy (car (member face icicle-proxy-candidates))))
2502 (if proxy
2503 (symbol-value (intern (substring proxy 1 (1- (length proxy)))))
2504 (intern face)))))))))
2505 (t
2506 (defun icicle-read-face-name (prompt &optional default multiple)
2507 "Read a face name with completion and return its face symbol.
2508 PROMPT should not end in a space or a colon.
2509
2510 If non-nil, DEFAULT should be a face (a symbol), a face name (a
2511 string) or a list of faces (symbols).
2512
2513 DEFAULT determines what is returned if the user just hits `RET' (empty
2514 input), as follows:
2515
2516 If DEFAULT is nil then return nil.
2517 If DEFAULT is a single face, then return its name.
2518 If DEFAULT is a list of faces, then:
2519
2520 If MULTIPLE is nil, return the name of the first face in the list.
2521 If MULTIPLE is non-nil, return DEFAULT.
2522
2523 If MULTIPLE is non-nil, read multiple face names and return them as a
2524 list. If MULTIPLE is nil, read and return a single face name.
2525
2526 If option `icicle-add-proxy-candidates-flag' is non-nil, then you can
2527 also enter the name of a face-name variable - its value is returned.
2528 A face-name variable is a variable with custom-type `face'.
2529
2530 If library `palette.el' or `eyedropper.el' is used, then you can also
2531 choose proxy candidate `*point face name*' to use the face at point."
2532 (or (require 'palette nil t) (require 'eyedropper nil t))
2533 (when (and default (not (stringp default)))
2534 (setq default (cond ((symbolp default) (symbol-name default))
2535 (multiple (mapconcat (lambda (fc) (if (symbolp fc) (symbol-name fc) fc))
2536 default ", "))
2537 (t (symbol-name (car default))))))
2538 (when (and default (not multiple))
2539 (require 'crm)
2540 ;; For compatibility with `completing-read-multiple' use `crm-separator' to define DEFAULT.
2541 (setq default (car (split-string default crm-separator t))))
2542 (save-match-data ; Undo Emacs 22+ brain-dead treatment of PROMPT arg.
2543 (when (string-match "\\(:\\s *$\\|:?\\s +$\\)" prompt)
2544 (setq prompt (substring prompt 0 (- (length (match-string 0 prompt)))))))
2545 (let ((prompt (if default
2546 (format "%s (default is %s): " prompt (if (equal default "all faces")
2547 "ALL faces"
2548 (format "`%s'" default)))
2549 (format "%s: " prompt)))
2550 (icicle-proxy-candidates
2551 (append (and icicle-add-proxy-candidates-flag (not icicle-exclude-default-proxies)
2552 (let ((ipc ()))
2553 (mapatoms
2554 (lambda (cand)
2555 (when (and (user-variable-p cand) (eq (get cand 'custom-type) 'face))
2556 (push `,(concat "'" (symbol-name cand) "'") ipc))))
2557 ipc))
2558 icicle-proxy-candidates)))
2559 (cond (multiple
2560 ;; We leave this branch as it is. Icicles does nothing special with
2561 ;; `completing-read-multiple'.
2562 (require 'crm)
2563 (let ((faces ())
2564 (aliasfaces ())
2565 (nonaliasfaces ()))
2566 (mapatoms (lambda (s) (when (facep s) ; Build up the completion tables.
2567 (if (get s 'face-alias)
2568 (push (symbol-name s) aliasfaces)
2569 (push (symbol-name s) nonaliasfaces)))))
2570 (dolist (face (completing-read-multiple prompt (completion-table-in-turn nonaliasfaces
2571 aliasfaces)
2572 nil t nil 'face-name-history default))
2573 ;; Ignore elements that are not faces (e.g., because DEFAULT was brain-dead "all faces").
2574 (if (facep face) (push (intern face) faces)))
2575 (nreverse faces))) ; Return the list of faces
2576 (t
2577 (let ((icicle-multi-completing-p t)
2578 (icicle-list-nth-parts-join-string ": ")
2579 (icicle-list-join-string ": ")
2580 (icicle-list-use-nth-parts '(1))
2581 (face-list (face-list))
2582 face)
2583 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
2584 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
2585 (while (equal "" (setq face (icicle-transform-multi-completion
2586 (completing-read
2587 prompt
2588 (mapcar #'icicle-make-face-candidate face-list)
2589 nil (not (stringp icicle-WYSIWYG-Completions-flag))
2590 nil (if (boundp 'face-name-history)
2591 'face-name-history
2592 'icicle-face-name-history)
2593 default)))))
2594 (let ((proxy (car (member face icicle-proxy-candidates))))
2595 (if proxy
2596 (symbol-value (intern (substring proxy 1 (1- (length proxy)))))
2597 (intern face))))))
2598 ))
2599 ))
2600
2601 (defun icicle-make-face-candidate (face)
2602 "Return a completion candidate for FACE.
2603 The value of option `icicle-WYSIWYG-Completions-flag' determines the
2604 kind of candidate to use.
2605 If nil, then the face name is used (a string).
2606
2607 If a string, then a multi-completion candidate is used, with the face
2608 name followed by a sample swatch using FACE on the string's text.
2609
2610 If t, then the candidate is the face name itself, propertized with
2611 FACE."
2612 (if (stringp icicle-WYSIWYG-Completions-flag)
2613 (let ((swatch (copy-sequence icicle-WYSIWYG-Completions-flag)))
2614 (put-text-property 0 (length icicle-WYSIWYG-Completions-flag) 'face face swatch)
2615 (list (list (symbol-name face) swatch)))
2616 (let ((face-name (copy-sequence (symbol-name face))))
2617 (when icicle-WYSIWYG-Completions-flag
2618 (put-text-property 0 (length face-name) 'face face face-name))
2619 (list face-name))))
2620
2621
2622 ;; REPLACE ORIGINAL `face-valid-attribute-values' in `faces.el',
2623 ;; saving it for restoration when you toggle `icicle-mode'.
2624 ;;
2625 ;; Show color names in `*Completions*' with the (background) colors they name.
2626 ;; This is really so that commands such as `modify-face' take advantage of colored candidates.
2627 ;; We don't bother to try the same thing for Emacs 20, but the fix (directly to `modify-face') is
2628 ;; similar and trivial.
2629 ;;
2630 (when (fboundp 'face-valid-attribute-values) ; Emacs 21+.
2631 (unless (fboundp 'icicle-ORIG-face-valid-attribute-values)
2632 (defalias 'icicle-ORIG-face-valid-attribute-values (symbol-function 'face-valid-attribute-values)))
2633
2634 (if (fboundp 'window-system) ; Emacs 23+
2635 ;; Emacs 23+ `font-family-list' is strings, not conses of strings like older `x-font-family-list'.
2636 (defun icicle-face-valid-attribute-values (attribute &optional frame)
2637 "Return valid values for face attribute ATTRIBUTE.
2638 The optional argument FRAME is used to determine available fonts
2639 and colors. If it is nil or not specified, the selected frame is
2640 used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
2641 out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
2642 an integer value."
2643 (let ((valid
2644 (case attribute
2645 (:family (if (window-system frame)
2646 (mapcar (lambda (x) (cons x x)) ; Just strings, so don't take car.
2647 (font-family-list))
2648 ;; Only one font on TTYs.
2649 (list (cons "default" "default"))))
2650 (:foundry
2651 (list nil))
2652 (:width
2653 (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-width-table))
2654 (:weight
2655 (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-weight-table))
2656 (:slant
2657 (mapcar (lambda (x) (cons (symbol-name (aref x 1)) (aref x 1))) font-slant-table))
2658 (:inverse-video
2659 (mapcar (lambda (x) (cons (symbol-name x) x))
2660 (internal-lisp-face-attribute-values attribute)))
2661 ((:underline :overline :strike-through :box)
2662 (if (window-system frame)
2663 (nconc (mapcar (lambda (x) (cons (symbol-name x) x))
2664 (internal-lisp-face-attribute-values attribute))
2665 (mapcar (lambda (c) (cons c c))
2666 (mapcar #'icicle-color-name-w-bg (defined-colors frame))))
2667 (mapcar (lambda (x) (cons (symbol-name x) x))
2668 (internal-lisp-face-attribute-values attribute))))
2669 ((:foreground :background)
2670 (mapcar (lambda (c) (cons c c))
2671 (mapcar #'icicle-color-name-w-bg (defined-colors frame))))
2672 ((:height) 'integerp)
2673 (:stipple (and (memq (window-system frame) '(x ns)) ; No stipple on w32
2674 (mapcar #'list (apply #'nconc (mapcar (lambda (dir)
2675 (and (file-readable-p dir)
2676 (file-directory-p dir)
2677 (directory-files dir)))
2678 x-bitmap-file-path)))))
2679 (:inherit (cons '("none" . nil)
2680 (mapcar (lambda (c) (cons (symbol-name c) c)) (face-list))))
2681 (t
2682 (error "`icicle-face-valid-attribute-values': YOU SHOULD NOT SEE THIS; \
2683 Use `M-x icicle-send-bug-report'")))))
2684 (if (and (listp valid) (not (memq attribute '(:inherit))))
2685 (nconc (list (cons "unspecified" 'unspecified)) valid)
2686 valid)))
2687 (defun icicle-face-valid-attribute-values (attribute &optional frame) ; Emacs 21-22.
2688 "Return valid values for face attribute ATTRIBUTE.
2689 The optional argument FRAME is used to determine available fonts
2690 and colors. If it is nil or not specified, the selected frame is
2691 used. Value is an alist of (NAME . VALUE) if ATTRIBUTE expects a value
2692 out of a set of discrete values. Value is `integerp' if ATTRIBUTE expects
2693 an integer value."
2694 (let ((valid
2695 (case attribute
2696 (:family (if window-system
2697 (mapcar (lambda (x) (cons (car x) (car x)))
2698 (if (fboundp 'font-family-list) (font-family-list) (x-font-family-list)))
2699 ;; Only one font on TTYs.
2700 (list (cons "default" "default"))))
2701 ((:width :weight :slant :inverse-video)
2702 (mapcar (lambda (x) (cons (symbol-name x) x))
2703 (internal-lisp-face-attribute-values attribute)))
2704 ((:underline :overline :strike-through :box)
2705 (if window-system
2706 (nconc (mapcar (lambda (x) (cons (symbol-name x) x))
2707 (internal-lisp-face-attribute-values attribute))
2708 (mapcar (lambda (c) (cons c c))
2709 (mapcar #'icicle-color-name-w-bg (x-defined-colors frame))))
2710 (mapcar (lambda (x) (cons (symbol-name x) x))
2711 (internal-lisp-face-attribute-values attribute))))
2712 ((:foreground :background)
2713 (mapcar (lambda (c) (cons c c)) (mapcar #'icicle-color-name-w-bg (x-defined-colors frame))))
2714 ((:height) 'integerp)
2715 (:stipple (and (memq window-system '(x w32 mac))
2716 (mapcar #'list (apply #'nconc (mapcar (lambda (dir)
2717 (and (file-readable-p dir)
2718 (file-directory-p dir)
2719 (directory-files dir)))
2720 x-bitmap-file-path)))))
2721 (:inherit (cons '("none" . nil)
2722 (mapcar (lambda (c) (cons (symbol-name c) c)) (face-list))))
2723 (t
2724 (error "`icicle-face-valid-attribute-values': YOU SHOULD NOT SEE THIS; \
2725 Use `M-x icicle-send-bug-report'")))))
2726 (if (and (listp valid) (not (memq attribute '(:inherit))))
2727 (nconc (list (cons "unspecified" 'unspecified)) valid)
2728 valid))))
2729
2730 (defun icicle-color-name-w-bg (color-name)
2731 "Return copy of string COLOR-NAME with its background of that color.
2732 If `hexrgb.el' is not loaded, then just return COLOR-NAME."
2733 (if (featurep 'hexrgb)
2734 (let ((propertized-name (copy-sequence color-name)))
2735 (put-text-property 0 (length propertized-name)
2736 'face (cons 'background-color (hexrgb-color-name-to-hex color-name))
2737 propertized-name)
2738 propertized-name)
2739 color-name)))
2740
2741
2742 ;; REPLACE ORIGINAL `completing-read-multiple' stuff in `crm.el',
2743 ;; saving it for restoration when you toggle `icicle-mode'.
2744 ;;
2745 ;; Essentially, we just inhibit Icicles features for Icicle mode.
2746 ;;
2747 (eval-after-load "crm"
2748 '(progn
2749 (when (fboundp 'crm-init-keymaps) (crm-init-keymaps)) ; Emacs 22, but not 23.
2750 ;; Save vanilla CRM stuff as `icicle-ORIG-' stuff.
2751 (unless (fboundp 'icicle-ORIG-completing-read-multiple)
2752 (fset 'icicle-ORIG-completing-read-multiple (symbol-function 'completing-read-multiple)))
2753 (defvar icicle-ORIG-crm-local-completion-map crm-local-completion-map "Original CRM completion map.")
2754 (defvar icicle-ORIG-crm-local-must-match-map crm-local-must-match-map "Original CRM must-match map.")
2755
2756 ;; Define CRM stuff to use in Icicle mode. Basically, just inhibit Icicles features.
2757 (defun icicle-completing-read-multiple (prompt collection &optional predicate require-match
2758 initial-input hist def inherit-input-method)
2759 "Read multiple strings in the minibuffer, with completion.
2760 Return the strings read, as a list.
2761
2762 By using this functionality, you can specify multiple strings at a
2763 single prompt, optionally using completion.
2764
2765 Most Icicles completions features are available, but because `TAB'
2766 here performs `crm' completion it does not also cycle among completion
2767 candidates. You can, as always, use `down' to do that.
2768
2769 You specify multiple strings by separating the strings with a
2770 prespecified separator regexp (separator character, prior to Emacs
2771 24.3). For example, if the separator regexp is \",\" then you specify
2772 the strings 'alice', 'bob', and 'eve' as 'alice,bob,eve'.
2773
2774 The separator regexp is the value of variable `crm-separator', whose
2775 default value is the value of `crm-default-separator'.
2776
2777 Contiguous strings of non-separator-characters are referred to as
2778 \"elements\". In the above example, the elements are 'alice', 'bob',
2779 and 'eve'.
2780
2781 Completion is available on a per-element basis. For example, if your
2782 input in the minibuffer is 'alice,bob,eve' and point is between the
2783 'l' and the 'i', pressing `TAB' operates on element 'alice'.
2784
2785 See `completing-read' for details about the arguments."
2786 (let ((icicle-highlight-input-completion-failure nil))
2787 (icicle-ORIG-completing-read-multiple prompt collection predicate require-match
2788 initial-input hist def inherit-input-method)))
2789
2790 ;; Helper function - workaround because of a lack of multiple inheritance for keymaps.
2791 (defun icicle-define-crm-completion-map (map)
2792 "Make basic bindings for keymap MAP, a crm completion map."
2793 (set-keymap-parent map minibuffer-local-completion-map)
2794 (define-key map [remap minibuffer-complete] ; Emacs 22, 23.
2795 (if (fboundp 'crm-complete) #'crm-complete #'crm-minibuffer-complete))
2796 (when (fboundp 'crm-complete-word)
2797 (define-key map [remap minibuffer-complete-word] #'crm-complete-word))
2798 (when (and (boundp 'icicle-word-completion-keys) (fboundp 'crm-complete-word))
2799 (dolist (key icicle-word-completion-keys) (define-key map key #'crm-complete-word)))
2800 (define-key map [remap minibuffer-completion-help] ; Emacs 22, 23.
2801 (if (fboundp 'crm-completion-help) #'crm-completion-help #'crm-minibuffer-completion-help))
2802 (define-key map "?" #'crm-completion-help) ; Put back `?' as help (self-insert for Icicles).
2803 (when (boundp 'icicle-prefix-complete-keys) ; Don't use Icicles completion.
2804 (dolist (key icicle-prefix-complete-keys)
2805 (define-key map key ; Emacs 22, 23.
2806 (if (fboundp 'crm-complete) #'crm-complete #'crm-minibuffer-complete)))))
2807
2808 (defvar icicle-crm-local-completion-map
2809 (let ((map (make-sparse-keymap)))
2810 (icicle-define-crm-completion-map map)
2811 map)
2812 "Local keymap for minibuffer multiple input with completion.
2813 Analog of `minibuffer-local-completion-map'.")
2814
2815 (defvar icicle-crm-local-must-match-map
2816 (let ((map (make-sparse-keymap)))
2817 (icicle-define-crm-completion-map map)
2818 (define-key map [remap minibuffer-complete-and-exit]
2819 (if (fboundp 'crm-complete-and-exit) #'crm-complete-and-exit #'crm-minibuffer-complete-and-exit))
2820 map)
2821 "Local keymap for minibuffer multiple input with exact match completion.
2822 Analog of `minibuffer-local-must-match-map' for crm.")
2823
2824 ;; Now, toggle Icicle mode, to take into account loading `crm.el' and redefining its stuff.
2825 (eval-after-load "icicles-mode" '(icicle-toggle-icicle-mode-twice))))
2826
2827
2828 ;; REPLACE ORIGINAL `read-shell-command' defined in `simple.el',
2829 ;; saving it for restoration when you toggle `icicle-mode'.
2830 ;; Uses Icicles completion.
2831 ;;
2832 (defun icicle-read-shell-command (prompt &optional initial-contents hist default-value
2833 inherit-input-method)
2834 "Read a shell command.
2835 Use file-name completion, unless INITIAL-CONTENTS is non-nil.
2836 For completion, pass args to `icicle-read-shell-command-completing'."
2837 (if initial-contents
2838 (if (fboundp 'icicle-ORIG-read-shell-command) ; Emacs < 23
2839 (icicle-ORIG-read-shell-command prompt initial-contents hist default-value inherit-input-method)
2840 (error "`icicle-read-shell-command': YOU SHOULD NOT SEE THIS; Use `M-x icicle-send-bug-report'"))
2841 (minibuffer-with-setup-hook
2842 (lambda ()
2843 (set (make-local-variable 'minibuffer-default-add-function)
2844 'minibuffer-default-add-shell-commands))
2845 (icicle-read-shell-command-completing prompt initial-contents (or hist 'shell-command-history)
2846 default-value inherit-input-method))))
2847
2848
2849 ;; REPLACE ORIGINAL `shell-command' defined in `simple.el',
2850 ;; saving it for restoration when you toggle `icicle-mode'.
2851 ;; Uses Icicles completion.
2852 ;;
2853 ;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
2854 ;;
2855 (unless (fboundp 'read-shell-command)
2856 ;; Emacs < 23 only
2857 (defun icicle-dired-smart-shell-command (command &optional output-buffer error-buffer)
2858 "Like `icicle-shell-command', but in the current Virtual Dired directory.
2859 Uses Icicles completion - see `icicle-read-shell-command-completing'."
2860 (interactive
2861 (list (icicle-read-shell-command "Shell command: " nil nil
2862 (cond (buffer-file-name (file-relative-name buffer-file-name))
2863 ((eq major-mode 'dired-mode) (dired-get-filename t t))))
2864 current-prefix-arg
2865 shell-command-default-error-buffer))
2866 (let ((default-directory (if (fboundp 'dired-default-directory) ; Emacs 21+.
2867 (dired-default-directory)
2868 (default-directory))))
2869 (icicle-shell-command command output-buffer error-buffer))))
2870
2871
2872 ;; REPLACE ORIGINAL `shell-command' defined in `simple.el',
2873 ;; saving it for restoration when you toggle `icicle-mode'.
2874 ;; Uses Icicles completion.
2875 ;;
2876 ;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
2877 ;;
2878 (unless (fboundp 'read-shell-command)
2879 ;; Emacs < 23 only
2880 (unless (fboundp 'icicle-ORIG-shell-command)
2881 (defalias 'icicle-ORIG-shell-command (symbol-function 'shell-command)))
2882
2883 (defun icicle-shell-command (command &optional output-buffer error-buffer)
2884 "Execute string COMMAND in inferior shell; display output, if any.
2885 Uses Icicles completion - see `icicle-read-shell-command-completing'.
2886
2887 With prefix argument, insert the COMMAND's output at point.
2888
2889 If COMMAND ends in ampersand, execute it asynchronously.
2890 The output appears in the buffer `*Async Shell Command*'.
2891 That buffer is in shell mode.
2892
2893 Otherwise, COMMAND is executed synchronously. The output appears in
2894 the buffer `*Shell Command Output*'. If the output is short enough to
2895 display in the echo area (which is determined by the variables
2896 `resize-mini-windows' and `max-mini-window-height'), it is shown
2897 there, but it is nonetheless available in buffer `*Shell Command
2898 Output*' even though that buffer is not automatically displayed.
2899
2900 To specify a coding system for converting non-ASCII characters
2901 in the shell command output, use \\[universal-coding-system-argument] \
2902 before this command.
2903
2904 Noninteractive callers can specify coding systems by binding
2905 `coding-system-for-read' and `coding-system-for-write'.
2906
2907 The optional second argument OUTPUT-BUFFER, if non-nil,
2908 says to put the output in some other buffer.
2909 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
2910 If OUTPUT-BUFFER is not a buffer and not nil,
2911 insert output in current buffer. (This cannot be done asynchronously.)
2912 In either case, the output is inserted after point (leaving mark after it).
2913
2914 If the command terminates without error, but generates output,
2915 and you did not specify \"insert it in the current buffer\",
2916 the output can be displayed in the echo area or in its buffer.
2917 If the output is short enough to display in the echo area
2918 \(determined by the variable `max-mini-window-height' if
2919 `resize-mini-windows' is non-nil), it is shown there.
2920 Otherwise,the buffer containing the output is displayed.
2921
2922 If there is output and an error, and you did not specify \"insert it
2923 in the current buffer\", a message about the error goes at the end
2924 of the output.
2925
2926 If there is no output, or if output is inserted in the current buffer,
2927 then `*Shell Command Output*' is deleted.
2928
2929 If the optional third argument ERROR-BUFFER is non-nil, it is a buffer
2930 or buffer name to which to direct the command's standard error output.
2931 If it is nil, error output is mingled with regular output.
2932 In an interactive call, the variable `shell-command-default-error-buffer'
2933 specifies the value of ERROR-BUFFER."
2934 (interactive
2935 (list (icicle-read-shell-command "Shell command: " nil nil
2936 (and buffer-file-name (file-relative-name buffer-file-name)))
2937 current-prefix-arg
2938 shell-command-default-error-buffer))
2939 (icicle-ORIG-shell-command command output-buffer error-buffer)))
2940
2941
2942 ;; REPLACE ORIGINAL `shell-command-on-region' defined in `simple.el',
2943 ;; saving it for restoration when you toggle `icicle-mode'.
2944 ;; Uses Icicles completion.
2945 ;;
2946 ;; Not needed for Emacs 23+ - Icicles completion is automatic via `icicle-read-shell-command'.
2947 ;;
2948 (unless (fboundp 'read-shell-command)
2949 ;; Emacs < 23 only
2950 (unless (fboundp 'icicle-ORIG-shell-command-on-region)
2951 (defalias 'icicle-ORIG-shell-command-on-region (symbol-function 'shell-command-on-region)))
2952
2953 (defun icicle-shell-command-on-region (start end command &optional output-buffer replace
2954 error-buffer display-error-buffer)
2955 "Execute string COMMAND in inferior shell with region as input.
2956 Uses Icicles completion - see `icicle-read-shell-command-completing'.
2957
2958 Normally, display any output in temp buffer `*Shell Command Output*';
2959 Prefix arg means replace the region with it. Return the exit code of
2960 COMMAND.
2961
2962 To specify a coding system for converting non-ASCII characters
2963 in the input and output to the shell command, use \\[universal-coding-system-argument]
2964 before this command. By default, the input (from the current buffer)
2965 is encoded in the same coding system that will be used to save the file,
2966 `buffer-file-coding-system'. If the output is going to replace the region,
2967 then it is decoded from that same coding system.
2968
2969 The noninteractive arguments are START, END, COMMAND,
2970 OUTPUT-BUFFER, REPLACE, ERROR-BUFFER, and DISPLAY-ERROR-BUFFER.
2971 Noninteractive callers can specify coding systems by binding
2972 `coding-system-for-read' and `coding-system-for-write'.
2973
2974 If the command generates output, the output may be displayed
2975 in the echo area or in a buffer.
2976 If the output is short enough to display in the echo area
2977 \(determined by the variable `max-mini-window-height' if
2978 `resize-mini-windows' is non-nil), it is shown there. Otherwise
2979 it is displayed in the buffer `*Shell Command Output*'. The output
2980 is available in that buffer in both cases.
2981
2982 If there is output and an error, a message about the error
2983 appears at the end of the output.
2984
2985 If there is no output, or if output is inserted in the current buffer,
2986 then `*Shell Command Output*' is deleted.
2987
2988 If the optional fourth argument OUTPUT-BUFFER is non-nil,
2989 that says to put the output in some other buffer.
2990 If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
2991 If OUTPUT-BUFFER is not a buffer and not nil,
2992 insert output in the current buffer.
2993 In either case, the output is inserted after point (leaving mark after it).
2994
2995 If REPLACE, the optional fifth argument, is non-nil, that means insert
2996 the output in place of text from START to END, putting point and mark
2997 around it.
2998
2999 If optional sixth argument ERROR-BUFFER is non-nil, it is a buffer
3000 or buffer name to which to direct the command's standard error output.
3001 If it is nil, error output is mingled with regular output.
3002 If DISPLAY-ERROR-BUFFER is non-nil, display the error buffer if there
3003 were any errors. (This is always t, interactively.) This argument is
3004 not available before Emacs 22.
3005 In an interactive call, the variable `shell-command-default-error-buffer'
3006 specifies the value of ERROR-BUFFER."
3007 (interactive (let (string)
3008 (unless (mark) (icicle-user-error "The mark is not set now, so no region"))
3009 ;; Do this before calling region-beginning and region-end, in case subprocess
3010 ;; output relocates them while we are in the minibuffer.
3011 (setq string (icicle-read-shell-command "Shell command on region: "))
3012 ;; call-interactively recognizes region-beginning and region-end specially,
3013 ;; leaving them in the history.
3014 (list (region-beginning) (region-end) string current-prefix-arg current-prefix-arg
3015 shell-command-default-error-buffer (= emacs-major-version 22))))
3016 (if (= emacs-major-version 22) ; `icicle-shell-command-on-region' not defined for Emacs 23+.
3017 (icicle-ORIG-shell-command-on-region start end command output-buffer replace error-buffer
3018 display-error-buffer)
3019 (icicle-ORIG-shell-command-on-region start end command output-buffer replace error-buffer))))
3020
3021 (defvar icicle-files () "A files list")
3022
3023
3024 ;; REPLACE ORIGINAL `dired-read-shell-command' defined in `dired-aux.el'
3025 ;; and redefined in `dired-x.el', saving it for restoration when you toggle `icicle-mode'.
3026 ;;
3027 ;; Uses Icicles completion.
3028 ;; Uses `icicle-minibuffer-default-add-dired-shell-commands', not
3029 ;; `minibuffer-default-add-dired-shell-commands'.
3030 ;; Binds `icicle-files' for use as free var elsewhere.
3031 ;; Added optional arg HISTORY.
3032 ;;
3033 (defun icicle-dired-read-shell-command (prompt arg files &optional history)
3034 "Read a shell command for FILES using file-name completion.
3035 Uses Icicles completion - see `icicle-read-shell-command-completing'.
3036 ARG is passed to `dired-mark-prompt' as its first arg, for the prompt.
3037 FILES are the files for which the shell command should be appropriate.
3038 Optional arg HISTORY is an alternative minibuffer history to use,
3039 instead of the default, `shell-command-history'. (HISTORY is not
3040 available for vanilla `dired-read-shell-command'.)"
3041 (let ((icicle-files files))
3042 (minibuffer-with-setup-hook
3043 (lambda ()
3044 (set (make-local-variable 'minibuffer-default-add-function)
3045 'icicle-minibuffer-default-add-dired-shell-commands))
3046 (dired-mark-pop-up nil 'shell files 'icicle-dired-guess-shell-command
3047 (format prompt (dired-mark-prompt arg files)) files
3048 (or history 'shell-command-history)))))
3049
3050 (defun icicle-dired-guess-shell-command (prompt files &optional history)
3051 "Read a shell command for FILES using file-name completion.
3052 Call `icicle-read-shell-command-completing', passing the arguments.
3053 If HISTORY is nil or not present then pass `shell-command-history'."
3054 (icicle-read-shell-command-completing prompt nil (or history 'shell-command-history) nil nil files))
3055
3056 ;; Similar to `minibuffer-default-add-dired-shell-commands', but if Dired-X is available
3057 ;; we include also the commands from `dired-guess-default'.
3058 ;;
3059 ;; Free var here: `icicle-files' is bound in `icicle-dired-read-shell-command'.
3060 ;;
3061 (defun icicle-minibuffer-default-add-dired-shell-commands ()
3062 "Return a list of all commands associated with current dired files.
3063 The commands are from `minibuffer-default-add-dired-shell-commands',
3064 and if `dired-x.el' is used, `dired-guess-default'."
3065 (interactive)
3066 (let ((dired-guess-cmds (and (boundp 'icicle-files) (fboundp 'dired-guess-default)
3067 (dired-guess-default icicle-files)))
3068 (mailcap-cmds (and (boundp 'icicle-files) (require 'mailcap nil t)
3069 (mailcap-file-default-commands icicle-files))))
3070 (when (stringp dired-guess-cmds) (setq dired-guess-cmds (list dired-guess-cmds)))
3071 (if (listp minibuffer-default)
3072 (append minibuffer-default dired-guess-cmds mailcap-cmds)
3073 (cons minibuffer-default (append dired-guess-cmds mailcap-cmds)))))
3074
3075 (defun icicle-read-shell-command-completing (prompt &optional initial-contents hist default-value
3076 _inherit-input-method files)
3077 "Read a shell command using file-name completion.
3078 FILES name some files for which the command might be appropriate.
3079 The other arguments are the same as those for `read-from-minibuffer',
3080 except that READ and KEYMAP are missing, HIST defaults to
3081 `shell-command-history', and _INHERIT-INPUT-METHOD is not used.
3082
3083 Completion is lax, so you can use any shell command you want, not
3084 just a completion candidate, and you can edit the completed input to
3085 add options and arguments etc.
3086
3087 In addition to file-name candidates, the following are combined to
3088 produce extra completion candidates (which are indicated using face
3089 `icicle-extra-candidates' in buffer `*Completions*'):
3090
3091 * If you use Dired X, then the rules defined by user option
3092 `dired-guess-shell-alist-user' and variable
3093 `dired-guess-shell-alist-default' provide candidates appropriate for
3094 the marked files in Dired.
3095
3096 * MIME-type associations provide candidates appropriate for the marked
3097 files (Emacs 23 and later),
3098
3099 * If option `icicle-guess-commands-in-path' is non-nil, then
3100 executable files (or all files, if `shell-completion-execonly' is
3101 nil) in your search path provide candidates.
3102
3103 In addition, if `icicle-extra-candidates' is non-nil, its elements are
3104 also included as extra candidates.
3105
3106 Help is available for individual candidates, using `C-M-RET',
3107 `C-M-mouse-2', and so on. For an extra candidate (that is, for a
3108 shell command guessed to be appropriate), help is provided by the
3109 `apropos' shell command (if available). For a file name, help shows
3110 the file's properties."
3111 (let* ((dired-guess-files (and files (fboundp 'dired-guess-default)
3112 (dired-guess-default files)))
3113 (icicle-sort-comparer 'icicle-extra-candidates-first-p)
3114 (completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
3115 (insert-default-directory nil)
3116 (icicle-extra-candidates-dir-insert-p nil)
3117 (icicle-point-position-in-candidate 'input-end)
3118 (icicle-candidate-help-fn (lambda (cand)
3119 (if (member cand icicle-extra-candidates)
3120 (with-output-to-temp-buffer "*Help*"
3121 (princ
3122 (shell-command-to-string
3123 (concat "apropos "
3124 (shell-quote-argument cand)))))
3125 (icicle-describe-file cand nil 'NO-ERROR-P))))
3126 (icicle-extra-candidates icicle-extra-candidates)
3127 (icicle-must-match-regexp icicle-file-match-regexp)
3128 (icicle-must-not-match-regexp icicle-file-no-match-regexp)
3129 (icicle-must-pass-after-match-predicate icicle-file-predicate)
3130 (icicle-transform-function 'icicle-remove-dups-if-extras)
3131 ;; (icicle-sort-comparer (or icicle-file-sort icicle-sort-comparer))
3132 (icicle-require-match-flag icicle-file-require-match-flag)
3133 (icicle-default-value ; Let user get default via `M-n', but don't insert it.
3134 (and (memq icicle-default-value '(t nil)) icicle-default-value)))
3135 (when (and dired-guess-files (atom dired-guess-files))
3136 (setq dired-guess-files (list dired-guess-files)))
3137 ;; Add dired-guess guesses and mailcap guesses to `icicle-extra-candidates'.
3138 (setq icicle-extra-candidates (append dired-guess-files (and files (require 'mailcap nil t) ; Emacs 23+.
3139 (fboundp 'mailcap-file-default-commands)
3140 (mailcap-file-default-commands files))
3141 icicle-extra-candidates))
3142 (when icicle-guess-commands-in-path ; Add commands available from user's search path.
3143 (setq icicle-extra-candidates (append icicle-extra-candidates
3144 (or icicle-shell-command-candidates-cache
3145 (icicle-recompute-shell-command-candidates)))))
3146 (when icicle-extra-candidates
3147 (setq prompt (copy-sequence prompt)) ; So we can modify it by adding property.
3148 (put-text-property 0 1 'icicle-fancy-candidates t prompt))
3149 (let ((cmd (icicle-read-file-name prompt nil default-value nil initial-contents nil hist)))
3150 (when icicle-quote-shell-file-name-flag (setq cmd (icicle-quote-file-name-part-of-cmd cmd)))
3151 cmd)))
3152
3153 (defun icicle-quote-file-name-part-of-cmd (strg)
3154 "Double-quote the file name that starts string STRG, for the shell.
3155 This assumes a UNIX-style shell, for which the following characters
3156 normally need to be escaped in file names: [ \t\n;<>&|()'\"#$].
3157 This is appropriate, for example, if you use Cygwin with MS Windows.
3158
3159 STRG is assumed to be a shell command, possibly including arguments
3160 and possibly ending with `&' to indicate asynchronous execution.
3161
3162 The beginning of STRG is assumed to be a file name, possibly including
3163 the characters [ \t\n;<>&|()'\"#$]. This function double-quotes the
3164 file name only, not the rest of STRG.
3165
3166 Example: If STRG is `c:/Program Files/My Dir/mycmd.exe arg1 arg2 &',
3167 and file c:/Program Files/My Dir/mycmd.exe exists, then this returns
3168 `\"c:/Program Files/My Dir/mycmd.exe\" arg1 arg2 &'."
3169 (save-match-data
3170 (if (not (string-match "[ \t\n;<>&|()'\"#$]" strg))
3171 strg
3172 (let ((indx 0)
3173 (compl "")
3174 (filename "")
3175 (quoted-strg strg)
3176 prefix)
3177 (while (and indx ; Find longest prefix that matches a file name.
3178 (setq indx (1+ (length compl)))
3179 (<= indx (length strg))
3180 (setq prefix (substring strg 0 indx))
3181 (setq compl (try-completion prefix 'read-file-name-internal
3182 (if (> emacs-major-version 22)
3183 minibuffer-completion-predicate
3184 default-directory))))
3185 (when (and (<= (length compl) (length strg)) (string-match compl strg 0)
3186 (or (icicle-file-remote-p compl) ; Don't let Tramp try to access it.
3187 (file-exists-p compl)))
3188 (setq filename compl)))
3189 (if (or (string= "" filename)
3190 (not (or (icicle-file-remote-p filename) ; Don't let Tramp try to access it.
3191 (file-exists-p filename))))
3192 strg
3193 (setq quoted-strg (concat "\"" filename "\""))
3194 (setq quoted-strg (concat quoted-strg (substring strg (length filename)))))))))
3195
3196
3197 ;; REPLACE ORIGINAL `recentf-make-menu-items' defined in `recentf.el',
3198 ;; saving it for restoration when you toggle `icicle-mode'.
3199 ;;
3200 ;; Adds Icicles submenu to `Open Recent' menu.
3201 ;;
3202 (defun icicle-recentf-make-menu-items (&optional menu)
3203 "Make menu items from the recent list.
3204 This is a menu filter function which ignores the MENU argument."
3205 (setq recentf-menu-filter-commands ())
3206 (let* ((recentf-menu-shortcuts 0)
3207 (file-items (icicle-condition-case-no-debug err
3208 (mapcar 'recentf-make-menu-item
3209 (recentf-apply-menu-filter recentf-menu-filter
3210 (recentf-menu-elements
3211 recentf-max-menu-items)))
3212 (error (message "recentf update menu failed: %s" (error-message-string err))))))
3213 (append (or file-items '(["No files" t :help "No recent file to open" :active nil]))
3214 (if recentf-menu-open-all-flag
3215 '(["All..." recentf-open-files :help "Open recent files through a dialog" :active t])
3216 (and (< recentf-max-menu-items (length recentf-list)) ; `recentf-list' is free here.
3217 '(["More..." recentf-open-more-files
3218 :help "Open files not in the menu through a dialog" :active t])))
3219 (and recentf-menu-filter-commands '("---")) recentf-menu-filter-commands
3220 (and recentf-menu-items-for-commands '("---")) recentf-menu-items-for-commands
3221 (and icicle-mode
3222 '(("Icicles"
3223 ["+ Open Recent File..." icicle-recent-file]
3224 ["+ Open Recent File (Other Window)..." icicle-recent-file-other-window]
3225 ["+ Remove from Recent Files List..." icicle-remove-file-from-recentf-list]))))))
3226
3227 ;;(@* "Icicles functions - completion display (not cycling)")
3228
3229 ;;; Icicles functions - completion display (not cycling) -------------
3230
3231 (defun icicle-display-candidates-in-Completions (&optional reverse-p no-display-p)
3232 "Refresh the current set of completion candidates in `*Completions*'.
3233 REVERSE-P non-nil means display the candidates in reverse order.
3234 NO-DISPLAY-P non-nil means do not display the candidates; just
3235 recompute them. If the value is `no-msg', then do not show a
3236 minibuffer message indicating that candidates were updated."
3237
3238 ;; FREE var used here (bound in `icicle-Info-index'): `icicle-Info-hist-list'.
3239
3240 ;;$$ ;; Pred is special if `minibuffer-completion-table' is a function.
3241 ;; (when (and (not (functionp minibuffer-completion-table))
3242 ;; (functionp minibuffer-completion-predicate))
3243 ;; (setq icicle-completion-candidates
3244 ;; (icicle-remove-if-not
3245 ;; (lambda (cand)
3246 ;; (funcall minibuffer-completion-predicate
3247 ;; (if (arrayp minibuffer-completion-table) (intern cand) (list cand))))
3248 ;; icicle-completion-candidates)))
3249
3250 ;; $$$ (case icicle-incremental-completion
3251 ;; ((t always) (setq icicle-incremental-completion-p 'always))
3252 ;; ((nil) (setq icicle-incremental-completion-p nil)))
3253
3254 ;; $$$$$ (unless (input-pending-p) ; Do nothing if user hit a key.
3255
3256 ;; Upgrade `icicle-incremental-completion-p' if we are redisplaying, so that completions will
3257 ;; be updated by `icicle-call-then-update-Completions' when you edit.
3258 (setq icicle-incremental-completion-p icicle-incremental-completion)
3259 (when (and (eq t icicle-incremental-completion-p) (get-buffer-window "*Completions*" 0))
3260 (setq icicle-incremental-completion-p 'always))
3261 (let ((nb-cands (length icicle-completion-candidates)))
3262 ;; $$$$$$ Could use this binding to prevent frame fitting, to allow room for images.
3263 ;; But that is not really the solution. Really should fit the frame or window in such a way
3264 ;; that it takes image sizes into account. Might need to wait for a fix to Emacs bug #7822.
3265 ;; (autofit-frames-flag (not icicle-image-files-in-Completions)))
3266 (cond ((eq no-display-p 'no-msg)) ; No-op.
3267 (no-display-p
3268 (icicle-msg-maybe-in-minibuffer
3269 "Candidates updated (%s matching): %s" icicle-current-completion-mode
3270 (icicle-propertize (format "%d" nb-cands) 'face 'icicle-msg-emphasis)))
3271 ((null icicle-completion-candidates)
3272 (save-selected-window (icicle-remove-Completions-window))
3273 (icicle-msg-maybe-in-minibuffer
3274 (if (eq 'apropos icicle-current-completion-mode)
3275 (let ((typ (car (rassq icicle-apropos-complete-match-fn
3276 icicle-S-TAB-completion-methods-alist))))
3277 (concat "No " typ (and typ " ") "completions"))
3278 (case (icicle-current-TAB-method)
3279 (fuzzy "No fuzzy completions")
3280 (swank "No swank (fuzzy symbol) completions")
3281 (vanilla "No vanilla completions")
3282 (t "No prefix completions")))))
3283 (t
3284 (when (> nb-cands icicle-incremental-completion-threshold)
3285 (message "Displaying completion candidates..."))
3286 ;; Display `*Completions*' now, so we can get its window's width.
3287 ;; We don't wait for `with-output-to-temp-buffer' to display it, because displaying it
3288 ;; might lead to splitting the display window, which would change its width.
3289 ;; We need to know the width in order to calculate the proper candidate formatting.
3290 (when (consp icicle-completion-candidates)
3291 (let ((fit-frame-inhibit-fitting-flag t)
3292 (comp-buf (get-buffer-create "*Completions*")))
3293 (unless (get-buffer-window comp-buf 'visible)
3294 (save-selected-window (display-buffer comp-buf t 0)
3295 (deactivate-mark))))) ; Remove any leftover mouse selection.
3296 (with-output-to-temp-buffer "*Completions*"
3297 ;; Each candidate in `icicle-completion-candidates' is a string, regardless of the
3298 ;; original type of candidate used (e.g. symbol, string, alist candidate,...). Here,
3299 ;; provided `icicle-fancy-cands-internal-p' is non-nil, we transform these candidates,
3300 ;; replacing each by a string that takes into account symbol properties
3301 ;; `icicle-display-string' and `icicle-special-candidate'.
3302 ;;
3303 ;; Because `icicle-completion-candidates' is affected, changes to the candidate strings
3304 ;; (e.g. propertizing) are also reflected in the completion return value chosen by the
3305 ;; user. It is not only the display in `*Completions*' that is affected.
3306 ;;
3307 ;; The symbol whose properties are used is the one in the current obarray that is named
3308 ;; by the string candidate to be transformed. If there is no such symbol, then no
3309 ;; transformation occurs. Unless `minibuffer-completion-table' is an obarray, the
3310 ;; global obarray is used to get the symbol.
3311 ;;
3312 ;; 1. If the symbol has an `icicle-display-string' property, then that property value
3313 ;; must be a string (possibly propertized). We replace the candidate by that string.
3314 ;;
3315 ;; 2. If the symbol has an `icicle-special-candidate' property, then we transfer the
3316 ;; property to the candidate string as a set of text properties. (If the value is
3317 ;; not a plist, and `icicle-special-candidate-regexp' is nil, then just apply face
3318 ;; `icicle-special-candidate'.) The effect is similar to using
3319 ;; `icicle-special-candidate-regexp', but the completion return value is also
3320 ;; affected.
3321 (when icicle-fancy-cands-internal-p
3322 (setq icicle-completion-candidates
3323 (mapcar (lambda (cand)
3324 (let* ((symb (intern-soft
3325 cand (and (arrayp minibuffer-completion-table)
3326 minibuffer-completion-table)))
3327 (display-strg (and symb
3328 (stringp (get symb 'icicle-display-string))
3329 (get symb 'icicle-display-string)))
3330 (new-cand (or display-strg cand))
3331 (spec-prop (and symb (get symb 'icicle-special-candidate))))
3332 ;; Apply `icicle-special-candidate' property's value.
3333 ;; If the value is a plist, then apply the properties as text props.
3334 ;; Else (the value is t), apply face `icicle-special-candidate'.
3335 (when spec-prop
3336 (setq new-cand (copy-sequence new-cand))
3337 (if (consp spec-prop)
3338 (add-text-properties 0 (length new-cand) spec-prop new-cand)
3339 (unless icicle-special-candidate-regexp
3340 (add-text-properties 0 (length new-cand)
3341 '(face icicle-special-candidate)
3342 new-cand))))
3343 new-cand))
3344 icicle-completion-candidates)))
3345 (icicle-display-completion-list (if reverse-p
3346 (reverse icicle-completion-candidates)
3347 icicle-completion-candidates)
3348 nil ; IGNORED
3349 nb-cands))
3350 (save-excursion
3351 (save-window-excursion
3352 (with-current-buffer (get-buffer "*Completions*")
3353 (let* ((buffer-read-only nil)
3354 (eob (point-max))
3355 (filep (or (icicle-file-name-input-p) icicle-abs-file-candidates))
3356 (dir (and filep icicle-last-input
3357 (icicle-file-name-directory icicle-last-input)))
3358 (histvar (and (symbolp minibuffer-history-variable)
3359 (boundp minibuffer-history-variable)
3360 minibuffer-history-variable))
3361 (hist (and histvar (if filep
3362 (let ((default-directory dir))
3363 (mapcar #'expand-file-name
3364 (symbol-value histvar)))
3365 (symbol-value histvar))))
3366 (case-fold-search
3367 ;; Don't bother with buffer completion, `read-buffer-completion-ignore-case'.
3368 (if (and filep (boundp 'read-file-name-completion-ignore-case))
3369 read-file-name-completion-ignore-case
3370 completion-ignore-case)))
3371 (when (fboundp 'remove-images) (remove-images (point-min) (point-max)))
3372 (goto-char (icicle-start-of-candidates-in-Completions))
3373 (while (not (eobp))
3374 (let* ((beg (point))
3375 (end (next-single-property-change beg 'mouse-face nil eob))
3376 (next (next-single-property-change end 'mouse-face nil eob))
3377 (faces ()))
3378
3379 ;; Highlight candidate specially if it is a proxy candidate.
3380 (let ((candidate (icicle-current-completion-in-Completions)))
3381 ;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
3382 (when (member candidate icicle-proxy-candidates)
3383 (setq faces (cons 'icicle-proxy-candidate faces))
3384 (if (not icicle-proxy-candidate-regexp)
3385 (add-text-properties beg end (cons 'face (list faces)))
3386 (save-match-data
3387 (when (string-match icicle-proxy-candidate-regexp candidate)
3388 (add-text-properties (+ beg (match-beginning 0)) (+ beg (match-end 0))
3389 (cons 'face (list faces))))))))
3390
3391 ;; Highlight candidate specially if it is an extra candidate.
3392 (let ((candidate (icicle-current-completion-in-Completions)))
3393 ;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
3394 (save-match-data
3395 (when (member candidate icicle-extra-candidates)
3396 (setq faces (cons 'icicle-extra-candidate faces))
3397 (add-text-properties beg end (cons 'face (list faces))))))
3398
3399 ;; Highlight candidate specially if it is a special candidate.
3400 (let ((candidate (icicle-current-completion-in-Completions)))
3401 ;;$$$ (when dir (setq candidate (expand-file-name candidate dir)))
3402 (save-match-data
3403 (when (and icicle-special-candidate-regexp
3404 (string-match icicle-special-candidate-regexp candidate))
3405 (setq faces (cons 'icicle-special-candidate faces))
3406 (add-text-properties (+ beg (match-beginning 0)) (+ beg (match-end 0))
3407 (cons 'face (list faces))))))
3408
3409 ;; Highlight candidate (`*-historical-candidate') if it was used previously.
3410 (when icicle-highlight-historical-candidates-flag
3411 (let ((candidate (icicle-current-completion-in-Completions)))
3412 (when (and (consp hist) (not (member candidate icicle-hist-cands-no-highlight)))
3413 (let ((default-directory dir))
3414 (when (member (if filep
3415 (expand-file-name (icicle-transform-multi-completion
3416 candidate))
3417 candidate)
3418 hist)
3419 (add-text-properties
3420 beg end `(face ,(setq faces (cons 'icicle-historical-candidate faces)))))))))
3421
3422 ;; Highlight Info index-entry cand (`icicle-historical-candidate-other')
3423 ;; if its node has been visited.
3424 ;;
3425 ;; FREE var here (bound in `icicle-Info-index'): `icicle-Info-hist-list'.
3426 (when (and (> emacs-major-version 21)
3427 (memq icicle-last-top-level-command '(Info-index icicle-Info-index))
3428 icicle-highlight-historical-candidates-flag
3429 (boundp 'icicle-Info-hist-list) (consp icicle-Info-hist-list)
3430 (<= nb-cands icicle-Info-visited-max-candidates)
3431 (progn (message "Highlighting topics in visited nodes...") t))
3432 (let ((candidate (icicle-current-completion-in-Completions)))
3433 (when (or (assoc candidate icicle-Info-index-cache)
3434 (icicle-some (mapcar 'cadr icicle-Info-hist-list)
3435 candidate
3436 #'icicle-Info-node-is-indexed-by-topic))
3437 (add-text-properties
3438 beg end `(face ,(setq faces (cons 'icicle-historical-candidate-other faces)))))))
3439
3440 ;; Highlight, inside the candidate, the expanded common match.
3441 (when (and icicle-current-input (not (string= "" icicle-current-input)))
3442 (save-excursion
3443 (save-restriction
3444 (narrow-to-region beg end) ; Restrict to the completion candidate.
3445 (when (re-search-forward (regexp-quote (icicle-minibuf-input-sans-dir
3446 icicle-current-input))
3447 nil t)
3448 (setq faces (cons 'icicle-common-match-highlight-Completions faces))
3449 (put-text-property (match-beginning 0) (point) 'face faces)))))
3450
3451 ;; Hide match for `icicle-current-input' (expanded common match, if available),
3452 ;; if `icicle-hide-common-match-in-Completions-flag' is non-nil.
3453 (save-excursion
3454 (save-restriction
3455 (narrow-to-region beg end) ; Restrict to the completion candidate.
3456 (when (and icicle-hide-common-match-in-Completions-flag icicle-common-match-string)
3457 (when (re-search-forward (regexp-quote icicle-common-match-string) nil t)
3458 (if (> emacs-major-version 20)
3459 (put-text-property (match-beginning 0) (point) 'display "...")
3460 (put-text-property (match-beginning 0) (point) 'invisible t))))))
3461
3462 ;; Highlight, inside the candidate, what the input expression matches.
3463 (unless (and icicle-current-raw-input (string= "" icicle-current-raw-input)
3464 icicle-apropos-complete-match-fn)
3465 (save-excursion
3466 (save-restriction
3467 (narrow-to-region beg end) ; Restrict to the completion candidate.
3468 (let ((fn (if (and (eq 'prefix icicle-current-completion-mode)
3469 (not (memq (icicle-current-TAB-method) '(fuzzy swank))))
3470 ;; $$$$$$ What is best for `vanilla' (Emacs 23) completion?
3471 'search-forward
3472 (case icicle-apropos-complete-match-fn
3473 (icicle-scatter-match
3474 (lambda (input bound noerr)
3475 (re-search-forward (icicle-scatter input) bound noerr)))
3476 (icicle-levenshtein-match
3477 (if (= icicle-levenshtein-distance 1)
3478 (lambda (input bound noerr)
3479 (re-search-forward (icicle-levenshtein-one-regexp input)
3480 bound noerr))
3481 're-search-forward))
3482 (otherwise 're-search-forward)))))
3483 (save-excursion
3484 (when (and (funcall fn (icicle-minibuf-input-sans-dir icicle-current-raw-input)
3485 nil t)
3486 (not (eq (match-beginning 0) (point))))
3487 (setq faces (cons 'icicle-match-highlight-Completions faces))
3488 (put-text-property (match-beginning 0) (point) 'face faces)))
3489
3490 ;; If `icicle-hide-non-matching-lines-flag' then hide all lines
3491 ;; of candidate that do not match current input.
3492 (let ((candidate (icicle-current-completion-in-Completions))
3493 (input (icicle-minibuf-input-sans-dir
3494 icicle-current-raw-input))
3495 (cbeg beg))
3496 (when (and icicle-hide-non-matching-lines-flag
3497 (string-match "\n" candidate)
3498 (not (string= "\n" candidate)))
3499 (goto-char cbeg)
3500 (while (not (eobp))
3501 (unless (funcall fn input (line-end-position) t)
3502 (if (> emacs-major-version 20)
3503 (put-text-property (line-beginning-position)
3504 (min (1+ (line-end-position)) (point-max))
3505 'display "...\n")
3506 (put-text-property (line-beginning-position)
3507 (min (1+ (line-end-position)) (point-max))
3508 'invisible t)))
3509 (forward-line 1))))))))
3510
3511 ;; Highlight candidate if it has been saved.
3512 (when (and icicle-highlight-saved-candidates-flag icicle-saved-completion-candidates)
3513 (let ((candidate (icicle-current-completion-in-Completions)))
3514 (when (member candidate icicle-saved-completion-candidates)
3515 (let ((ov (make-overlay beg end)))
3516 (push ov icicle-saved-candidate-overlays)
3517 (overlay-put ov 'face 'icicle-saved-candidate)
3518 (overlay-put ov 'priority '10)))))
3519
3520 ;; Treat `icicle-candidate-properties-alist'.
3521 ;; A `face' prop will unfortunately wipe out any `face' prop we just applied.
3522 (when icicle-candidate-properties-alist
3523 (save-excursion
3524 (save-restriction
3525 (narrow-to-region beg end) ; Restrict to the completion candidate.
3526 (let* ((candidate (buffer-substring (point-min) (point-max)))
3527 (orig-pt (point))
3528 (start 0)
3529 (end 0)
3530 (partnum 1)
3531 (join (concat "\\(" icicle-list-join-string "\\|\\'\\)"))
3532 (len-cand (length candidate))
3533 (len-join (length icicle-list-join-string))
3534 (first t))
3535 (save-match-data
3536 (while (and (or first
3537 (not (= end (match-beginning 0)))
3538 (< (+ end len-join) len-cand))
3539 (string-match join candidate (if (and (not first)
3540 (= end (match-beginning 0))
3541 (< end len-cand))
3542 (+ end len-join)
3543 end))
3544 (< end len-cand))
3545 (setq first nil
3546 end (or (match-beginning 0) len-cand))
3547 (let* ((entry (assq partnum
3548 icicle-candidate-properties-alist))
3549 (properties (cadr entry))
3550 (propertize-join-string (car (cddr entry))))
3551 (when properties
3552 (add-text-properties (+ start orig-pt) (+ end orig-pt) properties))
3553 (when propertize-join-string
3554 (add-text-properties (+ end orig-pt) (+ end orig-pt len-join)
3555 properties)))
3556 (setq partnum (1+ partnum)
3557 start (match-end 0))))))))
3558
3559 ;; Thumbnail image for an image file or image-file bookmark (Bookmark+): Maybe show it
3560 ;; in `*Completions*'; maybe show it only in `*Completions*' mouseover tooltip.
3561 (when (or (and icicle-image-files-in-Completions
3562 (if (fboundp 'display-graphic-p) (display-graphic-p) window-system)
3563 (or (and filep (fboundp 'image-file-name-regexp))
3564 (and icicle-show-multi-completion-flag
3565 (symbolp icicle-last-top-level-command)
3566 (string-match "^icicle-bookmark-"
3567 (symbol-name icicle-last-top-level-command)))))
3568 (and (boundp 'tooltip-mode) tooltip-mode icicle-image-preview-in-tooltip))
3569 (let ((image-file
3570 (if (and icicle-show-multi-completion-flag
3571 (symbolp icicle-last-top-level-command)
3572 ;; We could alternatively put a property on such symbols and
3573 ;; test that. But just matching the cmd name is OK so far.
3574 (string-match "^icicle-bookmark-"
3575 (symbol-name icicle-last-top-level-command)))
3576 ;; This is bound by the bookmark commands to `(1)': bookmark name.
3577 ;; The file name is part #2, so we rebind this here.
3578 (let ((icicle-list-use-nth-parts '(2)))
3579 (icicle-transform-multi-completion
3580 (icicle-current-completion-in-Completions)))
3581 (icicle-transform-multi-completion
3582 (icicle-current-completion-in-Completions)))))
3583 (when (and (require 'image-dired nil t)
3584 (icicle-string-match-p (image-file-name-regexp) image-file))
3585 (let ((thumb-img (append (image-dired-get-thumbnail-image image-file)
3586 '(:margin 2))))
3587 ;; In `tooltip-mode', show image preview on mouseover,
3588 ;; unless it is a thumbnail and `*Completions*' already shows thumbnails.
3589 (when (and (boundp 'tooltip-mode) tooltip-mode
3590 (or (not icicle-image-files-in-Completions)
3591 (not (numberp icicle-image-preview-in-tooltip))))
3592 (with-current-buffer "*Completions*"
3593 (put-text-property
3594 (point) (+ (point) (length (icicle-current-completion-in-Completions)))
3595 'help-echo 'icicle-mouseover-help)))
3596 (when icicle-image-files-in-Completions
3597 (let ((img-ov (overlays-in (point) (min (point-max) (1+ (point))))))
3598 (if img-ov
3599 (delete-overlay (car img-ov))
3600 (put-image thumb-img beg)
3601 (setq img-ov (loop for ov in (overlays-in
3602 (point) (min (point-max) (1+ (point))))
3603 when (overlay-get ov 'put-image) collect ov into ovs
3604 finally return (car ovs)))
3605 (overlay-put img-ov 'image-file image-file)
3606 (overlay-put img-ov 'thumb-img thumb-img)
3607 (overlay-put img-ov 'image-size (image-size thumb-img))))
3608 ;; `image-only'. Replace file name with a space.
3609 ;; And hide mouse-face highlighting, as it just confuses.
3610 (when (eq 'image-only icicle-image-files-in-Completions)
3611 (with-current-buffer "*Completions*"
3612 (put-text-property
3613 (point) (+ (point) (length (icicle-current-completion-in-Completions)))
3614 'mouse-face 'default))
3615 (let ((name-ov (overlays-in end end)))
3616 (if name-ov
3617 (delete-overlay (car name-ov))
3618 (setq name-ov (make-overlay beg end))
3619 (overlay-put name-ov 'display " ")))))))))
3620 (goto-char next)))
3621
3622 ;; Remove all newlines for images-only display.
3623 (when (eq icicle-image-files-in-Completions 'image-only)
3624 (save-excursion (goto-char (icicle-start-of-candidates-in-Completions))
3625 (while (and (re-search-forward "$") (not (eobp))) (delete-char 1)))))
3626 (set-buffer-modified-p nil)
3627 (setq buffer-read-only t))))
3628
3629 ;; Put lighter, number of candidates, completion mode, and sort order in mode line.
3630 (with-current-buffer (get-buffer "*Completions*")
3631 (set (make-local-variable 'mode-line-format)
3632 (format " %s%s%s, sorting %s%s"
3633 (icicle-propertize (format "%d" nb-cands) 'face 'icicle-mode-line-help)
3634 (if (and icicle-max-candidates
3635 (integerp icicle-max-candidates) ; Not `RESET'.
3636 (< icicle-max-candidates icicle-nb-candidates-before-truncation))
3637 (format "%s candidates shown"
3638 (icicle-propertize (format "/%d" icicle-nb-candidates-before-truncation)
3639 'face 'icicle-mode-line-help))
3640 " candidates")
3641 (if (memq icicle-current-completion-mode '(prefix apropos))
3642 (format ", %s completion"
3643 (icicle-propertize
3644 (cond ((eq 'apropos icicle-current-completion-mode)
3645 ;; If nil, COLLECTION arg is probably a fn and we set it to nil
3646 ;; to prevent automatic input matching in
3647 ;; `icicle-unsorted-apropos-candidates', because COLLECTION fn
3648 ;; does everything. So here we treat nil like `apropos'.
3649 (if icicle-apropos-complete-match-fn
3650 (or (car (rassq icicle-apropos-complete-match-fn
3651 icicle-S-TAB-completion-methods-alist))
3652 "")
3653 "apropos"))
3654 ((eq 'prefix icicle-current-completion-mode)
3655 (case (icicle-current-TAB-method)
3656 (fuzzy "fuzzy")
3657 (swank "swank (fuzzy symbol)")
3658 (vanilla "vanilla")
3659 (t "prefix"))))
3660 'face 'icicle-mode-line-help))
3661 "")
3662 (icicle-propertize (or (car (rassoc icicle-sort-comparer icicle-sort-orders-alist))
3663 "turned OFF")
3664 'face 'icicle-mode-line-help)
3665 (if (and icicle-reverse-sort-p icicle-sort-comparer)
3666 (icicle-propertize " (reversed)" 'face 'icicle-mode-line-help)
3667 "")))
3668 (let* ((lighter (cadr (assoc 'icicle-mode minor-mode-alist)))
3669 (regexp (and lighter (concat (regexp-quote icicle-lighter-truncation) "$")))
3670 props)
3671 (when lighter
3672 (setq lighter (concat lighter " ")
3673 props (text-properties-at 0 lighter))
3674 (when (string-match regexp lighter) (setq lighter (substring lighter 0 (match-beginning 0))))
3675 (add-text-properties 0 (length lighter) props lighter))
3676 (setq mode-line-format (concat lighter mode-line-format)))
3677 (goto-char (icicle-start-of-candidates-in-Completions))
3678 (set-window-point (get-buffer-window "*Completions*" 0) (point))
3679 (icicle-fit-completions-window))
3680
3681 ;; Use the same font family as the starting buffer. This is particularly for picking up
3682 ;; the proper font for Unicode chars in `*Completions*'. Emacs 23+ only.
3683 ;; But skip this if using `oneonone.el', since `1on1-display-*Completions*-frame' does it.
3684 (when (and (not (fboundp '1on1-display-*Completions*-frame))
3685 (get-buffer-window "*Completions*" 'visible)
3686 icicle-pre-minibuffer-buffer
3687 (> emacs-major-version 22))
3688 (save-window-excursion
3689 (select-window (get-buffer-window "*Completions*" 'visible))
3690 (when (one-window-p t) ; $$$$$ Also this? (window-dedicated-p (selected-window))
3691 (let* ((orig-win (get-buffer-window icicle-pre-minibuffer-buffer 'visible))
3692 (orig-font-fam (and (window-live-p orig-win)
3693 (save-window-excursion (select-window orig-win)
3694 (face-attribute 'default :family)))))
3695 (when orig-font-fam (set-face-attribute 'default (selected-frame) :family orig-font-fam))))))
3696 (message nil))))) ; Clear out any "Looking for..."
3697
3698 ;; Similar to `diredp-mouseover-help'.
3699 (defun icicle-mouseover-help (window buffer pos)
3700 "Show `help-echo' help for a file-name completion candidate.
3701 If `tooltip-mode' is on, file named at POS is an image file, and
3702 `icicle-image-preview-in-tooltip' is non-nil, then show image preview.
3703 Otherwise, show textual help."
3704 (let ((image-dired-thumb-width (or (and (wholenump icicle-image-preview-in-tooltip)
3705 icicle-image-preview-in-tooltip)
3706 image-dired-thumb-width))
3707 (image-dired-thumb-height (or (and (wholenump icicle-image-preview-in-tooltip)
3708 icicle-image-preview-in-tooltip)
3709 image-dired-thumb-height))
3710 file)
3711 (or (and (b