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