icicle update
[emacs.git] / .emacs.d / elisp / icicle / icicles-cmd1.el
1 ;;; icicles-cmd1.el --- Top-level commands for Icicles
2 ;;
3 ;; Filename: icicles-cmd1.el
4 ;; Description: Top-level commands for Icicles
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
7 ;; Copyright (C) 1996-2014, Drew Adams, all rights reserved.
8 ;; Created: Mon Feb 27 09:25:04 2006
9 ;; Last-Updated: Fri May 9 09:27:47 2014 (-0700)
10 ;; By: dradams
11 ;; Update #: 26968
12 ;; URL: http://www.emacswiki.org/icicles-cmd1.el
13 ;; Doc URL: http://www.emacswiki.org/Icicles
14 ;; Keywords: extensions, help, abbrev, local, minibuffer,
15 ;; keys, apropos, completion, matching, regexp, command
16 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x
17 ;;
18 ;; Features that might be required by this library:
19 ;;
20 ;; `apropos', `apropos-fn+var', `avoid', `cl', `cus-edit',
21 ;; `cus-face', `cus-load', `cus-start', `cus-theme', `doremi',
22 ;; `easymenu', `el-swank-fuzzy', `ffap', `ffap-', `frame-cmds',
23 ;; `frame-fns', `fuzzy', `fuzzy-match', `hexrgb', `icicles-fn',
24 ;; `icicles-mcmd', `icicles-opt', `icicles-var', `image-dired',
25 ;; `kmacro', `levenshtein', `misc-fns', `mouse3', `mwheel',
26 ;; `naked', `regexp-opt', `ring', `second-sel', `strings',
27 ;; `thingatpt', `thingatpt+', `wid-edit', `wid-edit+', `widget'.
28 ;;
29 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
30 ;;
31 ;;; Commentary:
32 ;;
33 ;; This is a helper library for library `icicles.el'. It defines
34 ;; top-level commands (and a few non-interactive functions used in
35 ;; those commands). Library `icicles-cmd2.el' is a continuation of
36 ;; this file (a single file for all top-level commands would be too
37 ;; large to upload to Emacs Wiki).
38 ;;
39 ;; For commands to be used mainly in the minibuffer or buffer
40 ;; `*Completions*', see `icicles-mcmd.el'.
41 ;;
42 ;; For Icicles documentation, see `icicles-doc1.el' and
43 ;; `icicles-doc2.el'.
44 ;;
45 ;; If you use the byte-compiled version of this library,
46 ;; `icicles-cmd1.elc', in Emacs 23, then it must be byte-compiled
47 ;; using Emacs 23. Otherwise, Icicles key completion (and perhaps
48 ;; other things?) will not work correctly.
49 ;;
50 ;; Macros defined here:
51 ;;
52 ;; `icicle-find-file-abs-no-search-action-1',
53 ;; `icicle-find-file-abs-of-content-action-1',
54 ;; `icicle-find-file-no-search-action-1',
55 ;; `icicle-find-file-of-content-action-1'.
56 ;;
57 ;; Widgets defined here:
58 ;;
59 ;; `icicle-file', `icicle-ORIG-file'.
60 ;;
61 ;; Commands defined here - (+) means a multi-command:
62 ;;
63 ;; (+)`clear-option', (+)`icicle-add-buffer-candidate',
64 ;; (+)`icicle-add-buffer-config',
65 ;; `icicle-add-entry-to-saved-completion-set', `icicle-apropos',
66 ;; `icicle-apropos-command', `icicle-apropos-function',
67 ;; `icicle-apropos-option', (+)`icicle-apropos-options-of-type',
68 ;; (+)`icicle-apropos-value', `icicle-apropos-variable',
69 ;; (+)`icicle-apropos-vars-w-val-satisfying',
70 ;; `icicle-apropos-zippy', `icicle-bbdb-complete-mail',
71 ;; `icicle-bbdb-complete-name', (+)`icicle-bookmark',
72 ;; (+)`icicle-bookmark-all-tags',
73 ;; (+)`icicle-bookmark-all-tags-other-window',
74 ;; (+)`icicle-bookmark-all-tags-regexp',
75 ;; (+)`icicle-bookmark-all-tags-regexp-other-window',
76 ;; (+)`icicle-bookmark-autofile',
77 ;; (+)`icicle-bookmark-autofile-all-tags',
78 ;; (+)`icicle-bookmark-autofile-all-tags-other-window',
79 ;; (+)`icicle-bookmark-autofile-all-tags-regexp',
80 ;; (+)`icicle-bookmark-autofile-all-tags-regexp-other-window',
81 ;; `icicle-bookmark-autofile-narrow',
82 ;; (+)`icicle-bookmark-autofile-other-window',
83 ;; (+)`icicle-bookmark-autofile-some-tags',
84 ;; (+)`icicle-bookmark-autofile-some-tags-other-window',
85 ;; (+)`icicle-bookmark-autofile-some-tags-regexp',
86 ;; (+)`icicle-bookmark-autofile-some-tags-regexp-other-window',
87 ;; (+)`icicle-bookmark-autonamed',
88 ;; `icicle-bookmark-autonamed-narrow',
89 ;; (+)`icicle-bookmark-autonamed-other-window',
90 ;; (+)`icicle-bookmark-autonamed-this-buffer',
91 ;; `icicle-bookmark-autonamed-this-buffer-narrow',
92 ;; (+)`icicle-bookmark-autonamed-this-buffer-other-window',
93 ;; (+)`icicle-bookmark-bookmark-file',
94 ;; `icicle-bookmark-bookmark-file-narrow',
95 ;; (+)`icicle-bookmark-bookmark-list',
96 ;; `icicle-bookmark-bookmark-list-narrow',
97 ;; (+)`icicle-bookmark-cmd', (+)`icicle-bookmark-desktop',
98 ;; `icicle-bookmark-desktop-narrow', (+)`icicle-bookmark-dired',
99 ;; `icicle-bookmark-dired-narrow',
100 ;; (+)`icicle-bookmark-dired-other-window',
101 ;; (+)`icicle-bookmarked-buffer-list',
102 ;; (+)`icicle-bookmarked-file-list', (+)`icicle-bookmark-file',
103 ;; (+)`icicle-bookmark-file-all-tags',
104 ;; (+)`icicle-bookmark-file-all-tags-other-window',
105 ;; (+)`icicle-bookmark-file-all-tags-regexp',
106 ;; (+)`icicle-bookmark-file-all-tags-regexp-other-window',
107 ;; (+)`icicle-bookmark-file-other-window',
108 ;; `icicle-bookmark-file-narrow',
109 ;; (+)`icicle-bookmark-file-some-tags',
110 ;; (+)`icicle-bookmark-file-some-tags-other-window',
111 ;; (+)`icicle-bookmark-file-some-tags-regexp',
112 ;; (+)`icicle-bookmark-file-some-tags-regexp-other-window',
113 ;; (+)`icicle-bookmark-file-this-dir',
114 ;; (+)`icicle-bookmark-file-this-dir-other-window',
115 ;; (+)`icicle-bookmark-file-this-dir-all-tags',
116 ;; (+)`icicle-bookmark-file-this-dir-all-tags-other-window',
117 ;; (+)`icicle-bookmark-file-this-dir-all-tags-regexp',
118 ;; (+)`icicle-bookmark-file-this-dir-all-tags-regexp-other-window',
119 ;; `icicle-bookmark-file-this-dir-narrow',
120 ;; (+)`icicle-bookmark-file-this-dir-some-tags',
121 ;; (+)`icicle-bookmark-file-this-dir-some-tags-other-window',
122 ;; (+)`icicle-bookmark-file-this-dir-some-tags-regexp',
123 ;; (+)`icicle-bookmark-file-this-dir-some-tags-regexp-other-window',
124 ;; (+)`icicle-bookmark-gnus', `icicle-bookmark-gnus-narrow',
125 ;; (+)`icicle-bookmark-gnus-other-window',
126 ;; (+)`icicle-bookmark-image', `icicle-bookmark-image-narrow',
127 ;; (+)`icicle-bookmark-image-other-window',
128 ;; (+)`icicle-bookmark-info', `icicle-bookmark-info-narrow',
129 ;; (+)`icicle-bookmark-info-other-window', `icicle-bookmark-jump',
130 ;; `icicle-bookmark-jump-other-window', (+)`icicle-bookmark-list',
131 ;; (+)`icicle-bookmark-local-file',
132 ;; `icicle-bookmark-local-file-narrow',
133 ;; (+)`icicle-bookmark-local-file-other-window',
134 ;; (+)`icicle-bookmark-man', `icicle-bookmark-man-narrow',
135 ;; (+)`icicle-bookmark-man-other-window',
136 ;; (+)`icicle-bookmark-non-file',
137 ;; `icicle-bookmark-non-file-narrow',
138 ;; (+)`icicle-bookmark-non-file-other-window',
139 ;; (+)`icicle-bookmark-other-window', (+)`icicle-bookmark-region',
140 ;; `icicle-bookmark-region-narrow',
141 ;; (+)`icicle-bookmark-region-other-window',
142 ;; (+)`icicle-bookmark-remote-file',
143 ;; `icicle-bookmark-remote-file-narrow',
144 ;; (+)`icicle-bookmark-remote-file-other-window',
145 ;; `icicle-bookmark-save-marked-files',
146 ;; `icicle-bookmark-save-marked-files-as-project',
147 ;; `icicle-bookmark-save-marked-files-more',
148 ;; `icicle-bookmark-save-marked-files-persistently',
149 ;; `icicle-bookmark-save-marked-files-to-variable',
150 ;; `icicle-bookmark-set', (+)`icicle-bookmark-some-tags',
151 ;; (+)`icicle-bookmark-some-tags-other-window',
152 ;; (+)`icicle-bookmark-some-tags-regexp',
153 ;; (+)`icicle-bookmark-some-tags-regexp-other-window',
154 ;; (+)`icicle-bookmark-specific-buffers',
155 ;; `icicle-bookmark-specific-buffers-narrow',
156 ;; (+)`icicle-bookmark-specific-buffers-other-window',
157 ;; (+)`icicle-bookmark-specific-files',
158 ;; `icicle-bookmark-specific-files-narrow',
159 ;; (+)`icicle-bookmark-specific-files-other-window',
160 ;; (+)`icicle-bookmark-temporary',
161 ;; `icicle-bookmark-temporary-narrow',
162 ;; (+)`icicle-bookmark-temporary-other-window',
163 ;; (+)`icicle-bookmark-this-buffer',
164 ;; `icicle-bookmark-this-buffer-narrow',
165 ;; (+)`icicle-bookmark-this-buffer-other-window',
166 ;; (+)`icicle-bookmark-url', `icicle-bookmark-url-narrow',
167 ;; (+)`icicle-bookmark-url-other-window', (+)`icicle-bookmark-w3m',
168 ;; `icicle-bookmark-w3m-narrow',
169 ;; (+)`icicle-bookmark-w3m-other-window', (+)`icicle-buffer',
170 ;; (+)`icicle-buffer-config', (+)`icicle-buffer-list',
171 ;; (+)`icicle-buffer-no-search',
172 ;; (+)`icicle-buffer-no-search-other-window',
173 ;; (+)`icicle-buffer-other-window', `icicle-cd-for-abs-files',
174 ;; `icicle-cd-for-loc-files', (+)`icicle-clear-history',
175 ;; (+)`icicle-clear-current-history', (+)`icicle-color-theme',
176 ;; `icicle-comint-dynamic-complete',
177 ;; `icicle-comint-dynamic-complete-filename',
178 ;; `icicle-comint-replace-by-expanded-filename',
179 ;; (+)`icicle-command-abbrev', (+)`icicle-command-abbrev-command',
180 ;; (+)`icicle-completing-yank', `icicle-customize-apropos',
181 ;; `icicle-customize-apropos-faces',
182 ;; `icicle-customize-apropos-groups',
183 ;; `icicle-customize-apropos-options',
184 ;; (+)`icicle-customize-apropos-options-of-type',
185 ;; (+)`icicle-customize-apropos-opts-w-val-satisfying',
186 ;; (+)`icicle-customize-face',
187 ;; (+)`icicle-customize-face-other-window',
188 ;; `icicle-customize-icicles-group', (+)`icicle-custom-theme',
189 ;; `icicle-dabbrev-completion', (+)`icicle-delete-file',
190 ;; (+)`icicle-delete-window', (+)`icicle-describe-option-of-type',
191 ;; `icicle-describe-process',
192 ;; (+)`icicle-describe-var-w-val-satisfying',
193 ;; (+)`icicle-delete-windows', (+)`icicle-directory-list',
194 ;; (+)`icicle-dired', `icicle-dired-chosen-files',
195 ;; `icicle-dired-chosen-files-other-window',
196 ;; (+)`icicle-dired-insert-as-subdir',
197 ;; (+)`icicle-dired-other-window', `icicle-dired-project',
198 ;; `icicle-dired-project-other-window',
199 ;; `icicle-dired-saved-file-candidates',
200 ;; `icicle-dired-saved-file-candidates-other-window',
201 ;; `icicle-dired-save-marked',
202 ;; `icicle-dired-save-marked-as-project',
203 ;; `icicle-dired-save-marked-more',
204 ;; `icicle-dired-save-marked-more-recursive',
205 ;; `icicle-dired-save-marked-persistently',
206 ;; `icicle-dired-save-marked-recursive',
207 ;; `icicle-dired-save-marked-to-cache-file-recursive',
208 ;; `icicle-dired-save-marked-to-fileset-recursive',
209 ;; `icicle-dired-save-marked-to-variable',
210 ;; `icicle-dired-save-marked-to-variable-recursive',
211 ;; `icicle-doremi-increment-variable+',
212 ;; (+)`icicle-execute-extended-command',
213 ;; (+)`icicle-execute-named-keyboard-macro', (+)`icicle-face-list',
214 ;; (+)`icicle-file', (+)`icicle-file-list',
215 ;; (+)`icicle-file-other-window', (+)`icicle-find-file',
216 ;; (+)`icicle-find-file-abs-no-search',
217 ;; (+)`icicle-find-file-abs-no-search-other-window',
218 ;; (+)`icicle-find-file-abs-of-content',
219 ;; (+)`icicle-find-file-abs-of-content-other-window',
220 ;; (+)`icicle-find-file-absolute',
221 ;; (+)`icicle-find-file-absolute-other-window',
222 ;; (+)`icicle-find-file-abs-read-only',
223 ;; (+)`icicle-find-file-abs-read-only-other-window',
224 ;; (+)`icicle-find-file-in-tags-table',
225 ;; (+)`icicle-find-file-in-tags-table-other-window',
226 ;; (+)`icicle-find-file-of-content',
227 ;; (+)`icicle-find-file-of-content-in-tags-table',
228 ;; (+)`icicle-find-file-of-content-in-tags-table-other-window',
229 ;; (+)`icicle-find-file-of-content-other-window',
230 ;; (+)`icicle-find-file-other-window',
231 ;; (+)`icicle-find-file-no-search',
232 ;; (+)`icicle-find-file-no-search-in-tags-table',
233 ;; (+)`icicle-find-file-no-search-in-tags-table-other-window',
234 ;; (+)`icicle-find-file-no-search-other-window',
235 ;; (+)`icicle-find-file-read-only',
236 ;; (+)`icicle-find-file-read-only-other-window',
237 ;; (+)`icicle-find-first-tag',
238 ;; (+)`icicle-find-first-tag-other-window', (+)`icicle-find-tag',
239 ;; `icicle-grep-saved-file-candidates',
240 ;; `icicle-gud-gdb-complete-command', (+)`icicle-increment-option',
241 ;; (+)`icicle-increment-variable', (+)`icicle-insert-buffer',
242 ;; (+)`icicle-keyword-list', (+)`icicle-kill-buffer',
243 ;; (+)`icicle-kmacro', `icicle-lisp-complete-symbol',
244 ;; (+)`icicle-locate', (+)`icicle-locate-file',
245 ;; (+)`icicle-locate-file-no-search',
246 ;; (+)`icicle-locate-file-no-search-no-symlinks',
247 ;; (+)`icicle-locate-file-no-search-no-symlinks-other-window',
248 ;; (+)`icicle-locate-file-no-search-other-window',
249 ;; (+)`icicle-locate-file-no-symlinks',
250 ;; (+)`icicle-locate-file-no-symlinks-other-window',
251 ;; (+)`icicle-locate-file-of-content',
252 ;; (+)`icicle-locate-file-of-content-no-symlinks',
253 ;; (+)`icicle-locate-file-of-content-no-symlinks-other-window',
254 ;; (+)`icicle-locate-file-of-content-other-window',
255 ;; (+)`icicle-locate-file-other-window',
256 ;; (+)`icicle-locate-other-window', (+)`icicle-locate-no-search',
257 ;; (+)`icicle-locate-no-search-other-window',
258 ;; (+)`icicle-locate-of-content',
259 ;; (+)`icicle-locate-of-content-other-window',
260 ;; `icicle-ORIG-customize-face',
261 ;; `icicle-ORIG-customize-face-other-window',
262 ;; `icicle-ORIG-dabbrev-completion',
263 ;; `icicle-ORIG-lisp-complete-symbol',
264 ;; `icicle-ORIG-lisp-completion-at-point',
265 ;; `icicle-ORIG-repeat-complex-command',
266 ;; (+)`icicle-other-window-or-frame', `icicle-pop-tag-mark',
267 ;; `icicle-pp-eval-expression', (+)`icicle-recent-file',
268 ;; (+)`icicle-recent-file-no-search',
269 ;; (+)`icicle-recent-file-no-search-other-window',
270 ;; (+)`icicle-recent-file-of-content',
271 ;; (+)`icicle-recent-file-of-content-other-window',
272 ;; (+)`icicle-recent-file-other-window',
273 ;; `icicle-recompute-shell-command-candidates',
274 ;; (+)`icicle-regexp-list', (+)`icicle-remove-buffer-candidate',
275 ;; (+)`icicle-remove-buffer-config',
276 ;; `icicle-remove-entry-from-saved-completion-set',
277 ;; (+)`icicle-remove-file-from-recentf-list',
278 ;; (+)`icicle-remove-saved-completion-set',
279 ;; `icicle-repeat-complex-command',
280 ;; (+)`icicle-reset-option-to-nil',
281 ;; (+)`icicle-select-bookmarked-region', (+)`icicle-select-frame',
282 ;; `icicle-select-frame-by-name', (+)`icicle-select-window',
283 ;; `icicle-select-window-by-name', `icicle-send-bug-report',
284 ;; (+)`icicle-send-signal-to-process', (+)`icicle-set-option-to-t',
285 ;; (+)`icicle-sexp-list', `icicle-shell-dynamic-complete-command',
286 ;; `icicle-shell-dynamic-complete-environment-variable',
287 ;; `icicle-shell-dynamic-complete-filename',
288 ;; (+)`icicle-string-list', (+)`icicle-toggle-option',
289 ;; (+)`icicle-visit-marked-file-of-content',
290 ;; (+)`icicle-visit-marked-file-of-content-other-window',
291 ;; (+)`icicle-visit-marked-file-of-content-recursive',
292 ;; (+)`icicle-visit-marked-file-of-content-recursive-other-window',
293 ;; `icicle-widget-file-complete',
294 ;; (+)`icicle-yank-maybe-completing',
295 ;; (+)`icicle-yank-pop-commands', `icicle-zap-to-char',
296 ;; (+)`toggle'.
297 ;;
298 ;; Non-interactive functions defined here:
299 ;;
300 ;; `custom-variable-p', `icicle-apropos-opt-action',
301 ;; `icicle-binary-option-p', `icicle-bookmark-act-on-prop',
302 ;; `icicle-bookmark-bind-narrow-commands',
303 ;; `icicle-bookmark-cleanup', `icicle-bookmark-cleanup-on-quit',
304 ;; `icicle-bookmark-delete-action', `icicle-bookmark-help',
305 ;; `icicle-bookmark-help-string', `icicle-bookmark-jump-1',
306 ;; `icicle-buffer-apropos-complete-match',
307 ;; `icicle-buffer-cand-help', `icicle-buffer-multi-complete',
308 ;; `icicle-buffer-name-prompt',
309 ;; `icicle-cached-files-without-buffers', `icicle-clear-history-1',
310 ;; `icicle-clear-history-entry',
311 ;; `icicle-comint-completion-at-point',
312 ;; `icicle-comint-dynamic-complete-as-filename',
313 ;; `icicle-comint-dynamic-simple-complete',
314 ;; `icicle-comint-replace-orig-completion-fns',
315 ;; `icicle-command-abbrev-action',
316 ;; `icicle-command-abbrev-matching-commands',
317 ;; `icicle-command-abbrev-record', `icicle-command-abbrev-regexp',
318 ;; `icicle-customize-apropos-opt-action', `icicle-customize-faces',
319 ;; `icicle-dabbrev--abbrev-at-point',
320 ;; `icicle-default-buffer-names',
321 ;; `icicle-delete-file-or-directory', `icicle-describe-opt-action',
322 ;; `icicle-describe-opt-of-type-complete',
323 ;; `icicle-execute-extended-command-1', `icicle-explore',
324 ;; `icicle-file-of-content-apropos-complete-match',
325 ;; (+)`icicle-find-file-abs-no-search-1',
326 ;; `icicle-find-file-abs-no-search-action',
327 ;; `icicle-find-file-abs-no-search-other-window-action',
328 ;; `icicle-find-file-abs-no-search-ro-action',
329 ;; `icicle-find-file-abs-no-search-ro-ow-action',
330 ;; (+)`icicle-find-file-abs-of-content-1',
331 ;; `icicle-find-file-abs-of-content-action',
332 ;; `icicle-find-file-abs-of-content-other-window-action',
333 ;; `icicle-find-file-abs-of-content-ro-action',
334 ;; `icicle-find-file-abs-of-content-ro-ow-action',
335 ;; `icicle-find-file-no-search-action',
336 ;; `icicle-find-file-no-search-other-window-action',
337 ;; (+)`icicle-find-file-no-search-in-tags-table-1',
338 ;; (+)`icicle-find-file-of-content-in-tags-table-1',
339 ;; `icicle-find-file-of-content-ro-action',
340 ;; `icicle-find-file-of-content-ro-ow-action',
341 ;; `icicle-find-file-or-expand-dir',
342 ;; `icicle-find-first-tag-action',
343 ;; `icicle-find-first-tag-other-window-action',
344 ;; `icicle-find-tag-action', `icicle-find-tag-define-candidates',
345 ;; `icicle-find-tag-define-candidates-1',
346 ;; `icicle-find-tag-final-act', `icicle-find-tag-help',
347 ;; `icicle-find-tag-quit-or-error', `icicle-insert-for-yank',
348 ;; `icicle-kill-a-buffer-and-update-completions',
349 ;; `icicle-kmacro-action', `icicle-lisp-completion-at-point',
350 ;; (+)`icicle-locate-file-no-search-1',
351 ;; (+)`icicle-locate-file-of-content-1',
352 ;; `icicle-make-bookmark-candidate',
353 ;; `icicle-make-file+date-candidate', `icicle-make-frame-alist',
354 ;; `icicle-make-window-alist',
355 ;; `icicle-bookmark-propertize-candidate',
356 ;; `icicle-pp-display-expression',
357 ;; `icicle-read-args-w-val-satisfying',
358 ;; (+)`icicle-recent-file-of-content-1',
359 ;; `icicle-recent-files-without-buffers.',
360 ;; `icicle-remove-buffer-candidate-action',
361 ;; `icicle-remove-buffer-config-action',
362 ;; `icicle-remove-from-recentf-candidate-action',
363 ;; `icicle-remove-saved-set-action',
364 ;; `icicle-repeat-complex-command--called-interactively-skip',
365 ;; `icicle-shell-command-on-file',
366 ;; `icicle-shell-dynamic-complete-as-command',
367 ;; `icicle-shell-dynamic-complete-as-environment-variable',
368 ;; (+)`icicle-visit-marked-file-of-content-1'.
369 ;;
370 ;; Internal variables defined here:
371 ;;
372 ;; `icicle-dabbrev--last-completion-buffer',
373 ;; `icicle-dabbrev--last-obarray', `icicle-existing-bufs',
374 ;; `icicle-find-file-abs-action-fn', `icicle-find-file-action-fn',
375 ;; `icicle-locate-file-no-symlinks-p',
376 ;; `icicle-locate-file-use-locate-p', `icicle-new-bufs-to-keep',
377 ;; `icicle-new-bufs-to-kill', `icicle-vmfoc-other-win-p',
378 ;; `icicle-vmfoc-recursive-p'.
379 ;;
380 ;;
381 ;; ***** NOTE: The following functions defined in `dabbrev.el' have
382 ;; been REDEFINED HERE:
383 ;;
384 ;; `dabbrev-completion' - Use Icicles minibuffer completion when there
385 ;; are multiple candidates.
386 ;;
387 ;;
388 ;; ***** NOTE: The following functions defined in `bbdb-com.el' have
389 ;; been REDEFINED HERE:
390 ;; (BBDB is available here: http://bbdb.sourceforge.net/.)
391 ;;
392 ;; `icicle-bbdb-complete-mail', `bbdb-complete-name' -
393 ;; Use Icicles minibuffer completion when there
394 ;; are multiple candidates.
395 ;;
396 ;;
397 ;; ***** NOTE: The following functions defined in `lisp.el' have
398 ;; been REDEFINED in Icicles:
399 ;;
400 ;; `lisp-complete-symbol' - Selects `*Completions*' window even if on
401 ;; another frame.
402 ;;
403 ;;
404 ;; ***** NOTE: The following function defined in `simple.el' has
405 ;; been REDEFINED HERE:
406 ;;
407 ;; `repeat-complex-command' - Use `completing-read' to read command.
408 ;;
409 ;;
410 ;; ***** NOTE: The following functions defined in `cus-edit.el' have
411 ;; been REDEFINED HERE:
412 ;;
413 ;; `customize-apropos', `customize-apropos-faces',
414 ;; `customize-apropos-groups', `customize-apropos-options' -
415 ;; Use `completing-read' to read the regexp.
416 ;; `customize-face', `customize-face-other-window' - Multi-commands.
417 ;;
418 ;;
419 ;; Key bindings made by Icicles: See "Key Bindings" in
420 ;; `icicles-doc2.el'.
421 ;;
422 ;; For descriptions of changes to this file, see `icicles-chg.el'.
423
424 ;;(@> "Index")
425 ;;
426 ;; If you have library `linkd.el' and Emacs 22 or later, load
427 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
428 ;; navigate around the sections of this doc. Linkd mode will
429 ;; highlight this Index, as well as the cross-references and section
430 ;; headings throughout this file. You can get `linkd.el' here:
431 ;; http://dto.freeshell.org/notebook/Linkd.html.
432 ;;
433 ;; (@> "Internal Variables (alphabetical)")
434 ;; (@> "Macros")
435 ;; (@> "Icicles Top-Level Commands, Part 1")
436
437 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
438 ;;
439 ;; This program is free software; you can redistribute it and/or
440 ;; modify it under the terms of the GNU General Public License as
441 ;; published by the Free Software Foundation; either version 3, or
442 ;; (at your option) any later version.
443 ;;
444 ;; This program is distributed in the hope that it will be useful,
445 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
446 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
447 ;; General Public License for more details.
448 ;;
449 ;; You should have received a copy of the GNU General Public License
450 ;; along with this program; see the file COPYING. If not, write to
451 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
452 ;; Floor, Boston, MA 02110-1301, USA.
453 ;;
454 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
455 ;;
456 ;;; Code:
457
458 (eval-when-compile (require 'cl)) ;; lexical-let[*], pushnew
459 ;; plus, for Emacs < 21: dolist, push
460 (eval-when-compile (when (>= emacs-major-version 21) (require 'recentf))) ;; recentf-mode
461 (require 'apropos-fn+var nil t) ;; (no error if not found):
462 ;; apropos-command, apropos-function, apropos-option, apropos-variable
463 (eval-when-compile
464 (when (< emacs-major-version 24) ; $$$$$$$$ TODO: Update it for Emacs 24+
465 (require 'dabbrev)))
466 ;; dabbrev-case-fold-search, dabbrev-upcase-means-case-search, dabbrev--last-abbreviation,
467 ;; dabbrev--check-other-buffers, dabbrev-case-replace, dabbrev--reset-global-variables,
468 ;; dabbrev--find-all-expansions, dabbrev--substitute-expansion
469 (eval-when-compile (require 'bookmark))
470 ;; bookmark-all-names, bookmark-buffer-name, bookmark-current-bookmark
471 (eval-when-compile (require 'comint))
472 ;; comint-completion-addsuffix, comint-completion-autolist, comint-completion-fignore,
473 ;; comint-completion-recexact, comint-directory, comint-dynamic-complete-filename,
474 ;; comint-dynamic-complete-functions, comint-line-beginning-position,
475 ;; comint-match-partial-filename, comint-quote-filename
476 (eval-when-compile (require 'cookie1 nil t)) ;; (no error if not found): cookie-cache
477 (eval-when-compile (require 'shell)) ;; shell-backward-command, shell-completion-execonly,
478 ;; shell-dynamic-complete-command, shell-dynamic-complete-environment-variable,
479 ;; shell-dynamic-complete-filename, shell-match-partial-variable
480 (eval-when-compile (require 'etags))
481 ;; file-of-tag, find-tag, find-tag-default, find-tag-default-function,
482 ;; find-tag-marker-ring, find-tag-other-window, goto-tag-location-function, snarf-tag-function,
483 ;; tag-find-file-of-tag-noselect, tags-case-fold-search,
484 ;; tags-lazy-completion-table, tags-table-files, visit-tags-table-buffer
485 (eval-when-compile (require 'yow nil t)) ;; (no error if not found):
486 ;; apropos-zippy, yow-after-load-message, yow-file, yow-load-message
487
488 ;; Commented out because `synonyms.el' soft-requires Icicles.
489 ;; (eval-when-compile (require 'synonyms nil t)) ;; (no error if not found):
490 ;; synonyms-ensure-synonyms-read-from-cache, synonyms-obarray
491 (eval-when-compile (require 'misc-cmds nil t)) ;; (no error if not found):
492 ;; kill-buffer-and-its-windows
493 (eval-when-compile (require 'bbdb nil t) (require 'bbdb-com nil t)) ;; (no error if not found):
494 ;; bbdb-auto-fill-function, bbdb-complete-name, bbdb-complete-name-allow-cycling,
495 ;; bbdb-complete-name-cleanup, bbdb-complete-name-hooks, bbdb-completion-display-record,
496 ;; bbdb-completion-predicate, bbdb-completion-type, bbdb-display-records-1,
497 ;; bbdb-dwim-net-address, bbdb-expand-mail-aliases, bbdb-extract-address-components-func,
498 ;; bbdb-gag-messages, bbdb-hashtable, bbdb-mapc, bbdb-pop-up-bbdb-buffer, bbdb-record-aka,
499 ;; bbdb-record-name, bbdb-record-net, bbdb-search-intertwingle, bbdb-string-trim
500 (require 'cus-edit)
501 ;; customize-apropos, customize-apropos-faces, customize-apropos-groups,
502 ;; customize-apropos-options, custom-buffer-create, custom-buffer-order-groups, customize-face,
503 ;; customize-face-other-window, custom-sort-items
504 (require 'misc-fns nil t) ;; (no error if not found): another-buffer
505 (require 'frame-cmds nil t) ;; (no error if not found): delete-windows-on (my version)
506 (require 'second-sel nil t) ;; (no error if not found):
507 ;; secondary-selection-yank-commands, secondary-selection-yank-secondary-commands,
508 ;; yank-pop-secondary
509
510 (eval-when-compile
511 (or (condition-case nil
512 (load-library "icicles-mac") ; Use load-library to ensure latest .elc.
513 (error nil))
514 (require 'icicles-mac))) ; Require, so can load separately if not on `load-path'.
515 ;; icicle-assoc-delete-all, icicle-(buffer|file)-bindings, icicle-condition-case-no-debug,
516 ;; icicle-define-bookmark(-other-window)-command, icicle-define(-file)-command,
517 ;; icicle-define-add-to-alist-command
518 (require 'icicles-mcmd)
519 ;; icicle-bind-buffer-candidate-keys, icicle-bind-file-candidate-keys, icicle-unbind-buffer-candidate-keys,
520 ;; icicle-unbind-file-candidate-keys, icicle-yank
521 (require 'icicles-opt) ; (This is required anyway by `icicles-var.el'.)
522 ;; icicle-act-before-cycle-flag, icicle-add-proxy-candidates-flag, icicle-buffer-configs,
523 ;; icicle-buffer-extras, icicle-buffer-ignore-space-prefix-flag, icicle-buffer-match-regexp,
524 ;; icicle-buffer-no-match-regexp, icicle-buffer-predicate, icicle-buffer-require-match-flag,
525 ;; icicle-buffer-sort, icicle-color-themes, icicle-delete-candidate-object, icicle-kbd, icicle-recenter,
526 ;; icicle-saved-completion-sets, icicle-shell-command-candidates-cache, icicle-sort-comparer,
527 ;; icicle-sort-orders-alist, icicle-transform-function
528 (require 'icicles-var) ; (This is required anyway by `icicles-fn.el'.)
529 ;; icicle-abs-file-candidates, icicle-all-candidates-action, icicle-all-candidates-list-action-fn,
530 ;; icicle-all-candidates-list-alt-action-fn, icicle-allowed-sort-predicate, icicle-apropos-complete-match-fn,
531 ;; icicle-apropos-value-last-initial-cand-set, icicle-bookmark-list-names-only-p, icicle-bookmark-types,
532 ;; icicle-buffer-complete-fn, icicle-bufflist, icicle-candidate-action-fn, icicle-candidate-alt-action-fn,
533 ;; icicle-candidate-help-fn, icicle-candidate-nb, icicle-candidate-properties-alist, icicle-candidates-alist,
534 ;; icicle-command-abbrev-history, icicle-commands-for-abbrev, icicle-comp-base-is-default-dir-p,
535 ;; icicle-completion-candidates, icicle-compute-narrowing-regexp-p, icicle-current-completion-mode,
536 ;; icicle-current-input, icicle-exclude-default-proxies, icicle-explore-final-choice,
537 ;; icicle-explore-final-choice-full, icicle-extra-candidates, icicle-fancy-candidates-p, icicle-frame-alist,
538 ;; icicle-frame-name-history, icicle-full-cand-fn, icicle-get-alist-candidate-function, icicle-hist-var,
539 ;; icicle-incremental-completion-p, icicle-inhibit-sort-p, icicle-inhibit-try-switch-buffer,
540 ;; icicle-kmacro-alist, icicle-last-apropos-complete-match-fn, icicle-last-transform-function,
541 ;; icicle-list-use-nth-parts, icicle-multi-completing-p, icicle-must-match-regexp,
542 ;; icicle-must-not-match-regexp, icicle-must-pass-after-match-predicate, icicle-narrow-regexp,
543 ;; icicle-new-last-cmd, icicle-orig-buff, icicle-orig-must-pass-after-match-pred, icicle-orig-pt-explore,
544 ;; icicle-orig-window, icicle-orig-win-explore, icicle-other-window, icicle-path-variables,
545 ;; icicle-predicate-types-alist, icicle-pref-arg, icicle-pre-minibuffer-buffer,
546 ;; icicle-previous-raw-file-name-inputs, icicle-previous-raw-non-file-name-inputs, icicle-prompt,
547 ;; icicle-proxy-candidates, icicle-read-expression-map, icicle-remove-icicles-props-p, icicle-re-no-dot,
548 ;; icicle-saved-completion-candidates, icicle-search-history, icicle-transform-before-sort-p,
549 ;; icicle-use-candidates-only-once-alt-p, icicle-whole-candidate-as-text-prop-p
550 (require 'icicles-fn) ; (This is required anyway by `icicles-mcmd.el'.)
551 ;; icicle-delete-dups, icicle-highlight-lighter, icicle-multi-comp-apropos-complete-match,
552 ;; icicle-read-from-minibuf-nil-default, icicle-read-regexp, icicle-string-match-p
553
554
555 ;; Byte-compiling this file, you will likely get some byte-compiler warning messages.
556 ;; These are probably benign - ignore them. Icicles is designed to work with multiple
557 ;; versions of Emacs, and that fact provokes compiler warnings. If you get byte-compiler
558 ;; errors (not warnings), then please report a bug, using `M-x icicle-send-bug-report'.
559
560 ;;; Some defvars to quiet byte-compiler a bit:
561
562 (when (< emacs-major-version 21)
563 (defvar eval-expression-debug-on-error))
564
565 (when (< emacs-major-version 22)
566 (defvar history-delete-duplicates)
567 (defvar icicle-kmacro-alist) ; In `icicles-var.el'
568 (defvar kmacro-ring) ; In `kmacro.el'
569 (defvar read-file-name-completion-ignore-case) ; In `minibuffer.el'
570 (defvar tags-case-fold-search) ; In `etags.el'
571 (defvar tooltip-mode)) ; In `tooltip.el'
572
573 (when (< emacs-major-version 23)
574 (defvar read-buffer-completion-ignore-case))
575
576 (when (< emacs-major-version 24)
577 (defvar minibuffer-local-filename-syntax))
578
579 (defvar apropos-do-all) ; In `apropos.el'
580 (defvar bbdb-complete-mail-allow-cycling) ; In `bbdb-com.el'
581 (defvar bbdb-complete-name-allow-cycling) ; In `bbdb-com.el', older BBDB versions
582 (defvar bbdb-completion-list) ; In `bbdb-come.el'
583 (defvar bbdb-extract-address-components-func) ; In `bbdb-com.el'
584 (defvar bbdb-expand-mail-aliases) ; In `bbdb-com.el'
585 (defvar bbdb-complete-name-hooks) ; In `bbdb-com.el', older BBDB versions
586 (defvar bbdb-completion-display-record) ; In `bbdb.el'
587 (defvar bbdb-completion-type) ; In `bbdb.el'
588 (defvar bbdb-hashtable) ; In `bbdb.el'
589 (defvar bbdb-version) ; In `bbdb.el'
590 (defvar bmkp-non-file-filename) ; In `bookmark+-1.el'
591 (defvar bmkp-prompt-for-tags-flag) ; In `bookmark+-1.el'
592 (defvar bmkp-sorted-alist) ; In `bookmark+-1.el'
593 (defvar bookmark-current-point) ; In `bookmark.el' (Emacs < 23)
594 (defvar color-theme) ; In `color-theme.el'
595 (defvar color-themes) ; In `color-theme.el'
596 (defvar color-theme-initialized) ; In `color-theme.el'
597 (defvar cookie-cache)
598 (defvar custom-enabled-themes) ; In `custom.el' (Emacs 24+)
599 (defvar dabbrev-case-fold-search) ; In `dabbrev.el'
600 (defvar dabbrev-case-replace) ; In `dabbrev.el'
601 (defvar dabbrev-abbrev-char-regexp) ; In `dabbrev.el'
602 (defvar dabbrev--check-other-buffers) ; In `dabbrev.el'
603 (defvar dabbrev--last-abbreviation) ; In `dabbrev.el'
604 (defvar dabbrev--last-abbrev-location) ; In `dabbrev.el'
605 (defvar dabbrev-upcase-means-case-search) ; In `dabbrev.el'
606 (defvar ess-current-process-name) ; In `ess-inf.el'
607 (defvar ess-mode-syntax-table) ; In `ess-cust.el'
608 (defvar ess-use-R-completion) ; In `ess-cust.el'
609 (defvar file-cache-alist) ; In `filecache.el'
610 (defvar filesets-data) ; In `filesets.el'
611 (defvar find-tag-default-function) ; In `etags.el'
612 (defvar find-tag-marker-ring) ; In `etags.el'
613 (defvar goto-tag-location-function) ; In `etags.el'
614 (defvar icicle-buffer-easy-files) ; Here
615 (defvar icicle-clear-history-hist) ; In `icicle-clear-history-1',`icicle-clear-current-history'
616 (defvar icicle-custom-themes) ; In `icicles-opt.el' (Emacs 24+)
617 (defvar icicle-custom-themes-accumulate-flag) ; In `icicles-opt.el' (Emacs 24+)
618 (defvar icicle-custom-themes-update-flag) ; In `icicles-opt.el' (Emacs 24+)
619 (defvar icicle--last-toggle-transforming-msg) ; Here
620 (defvar icicle-window-alist) ; In `icicle-select-window'
621 (defvar locate-make-command-line) ; In `locate.el'
622 (defvar proced-signal-list) ; In `proced.el' (Emacs 23+)
623 (defvar recentf-list) ; In `recentf.el'
624 (defvar shell-completion-execonly) ; In `shell.el'
625 (defvar snarf-tag-function) ; In `etags.el'
626 (defvar translation-table-for-input) ; Built-in, Emacs 21+
627 (defvar w3m-current-title) ; In `w3m.el'
628 (defvar yow-after-load-message)
629 (defvar yow-file)
630 (defvar yow-load-message)
631
632 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
633
634 ;;(@* "Internal Variables (alphabetical)")
635
636 ;;; Internal variables (alphabetical) --------------------------------
637
638 (defvar icicle-existing-bufs ()
639 "List of existing buffers before a content-searching command.")
640
641 (defvar icicle-find-file-abs-action-fn nil
642 "Action function used in commands that find an absolute file name.")
643
644 (defvar icicle-find-file-action-fn nil
645 "Action function used in commands that use `read-file-name'.")
646
647 (defvar icicle-locate-file-no-symlinks-p nil
648 "Flag bound in `icicle-locate-file*' for use by `icicle-files-within'.")
649
650 (defvar icicle-locate-file-use-locate-p nil
651 "Flag bound to non-nil in `icicle-locate(-other-window)'.
652 Non-nil means `icicle-locate-file*' uses external command `locate'.")
653
654 (defvar icicle-new-bufs-to-keep ()
655 "List of temporary buffers for content-searching commands.")
656
657 (defvar icicle-new-bufs-to-kill ()
658 "List of temporary buffers for content-searching commands.")
659
660 ;;(@* "Macros")
661
662 ;;; Macros -----------------------------------------------------------
663
664 (defmacro icicle-find-file-abs-no-search-action-1 (other-window-p read-only-p)
665 "Action function for commands reading absolute file names without searching.
666 Non-nil OTHER-WINDOW-P means use other window.
667 Non-nil READ-ONLY-P means visit file in read-only mode."
668 `(lambda (file)
669 (let ((r-o (or ,read-only-p
670 (and (memq this-command '(icicle-candidate-action icicle-mouse-candidate-action
671 icicle-all-candidates-action))
672 current-prefix-arg)))
673 (fil (icicle-transform-multi-completion file)))
674 (if r-o
675 (if ,other-window-p
676 (find-file-read-only-other-window fil 'WILDCARDS)
677 (find-file-read-only fil 'WILDCARDS))
678 (if ,other-window-p
679 (find-file-other-window fil 'WILDCARDS)
680 (find-file fil 'WILDCARDS))))))
681
682 (defmacro icicle-find-file-no-search-action-1 (other-window-p)
683 "Action function for commands using `read-file-name' without searching.
684 Non-nil OTHER-WINDOW-P means use other window."
685 ;; FREE VARS here: CURRENT-PREFIX-ARG, THIS-COMMAND, `icicle-pref-arg'.
686 `(lambda (file)
687 (let ((r-o (if (memq this-command '(icicle-candidate-action icicle-mouse-candidate-action
688 icicle-all-candidates-action))
689 (or (and ,icicle-pref-arg (not current-prefix-arg))
690 (and (not ,icicle-pref-arg) current-prefix-arg))
691 ,icicle-pref-arg)))
692 (icicle-find-file-or-expand-dir file #'icicle-find-file-no-search-1 r-o ,other-window-p))))
693
694 (defmacro icicle-find-file-abs-of-content-action-1 (other-window-p read-only-p)
695 "File-visiting action function for commands reading absolute file names.
696 Non-nil OTHER-WINDOW-P means use other window.
697 Non-nil READ-ONLY-P means visit file in read-only mode."
698 `(lambda (file)
699 (setq file (icicle-transform-multi-completion file)
700 file (if (string= "" (file-name-nondirectory file)) (directory-file-name file) file))
701 (let* ((r-o (or ,read-only-p
702 (and (memq this-command '(icicle-candidate-action icicle-mouse-candidate-action
703 icicle-all-candidates-action))
704 current-prefix-arg))) ; Use this, not `icicle-pref-arg': for this candidate.
705 ;; If FILE uses wildcards there are multiple files to visit.
706 (wildfiles (file-expand-wildcards file)))
707
708 ;; For each matching file name, kill any buffers created for content-searching it, so that
709 ;; `find-file*' DTRT wrt file-local variable declarations, file handlers, find-file hooks etc.
710 (dolist (fil wildfiles)
711 (let ((created-buf (car (memq (find-buffer-visiting fil) icicle-new-bufs-to-kill))))
712 (when (and (buffer-live-p created-buf) (not (memq created-buf icicle-new-bufs-to-keep)))
713 ;;; $$$$$$ Why were we calling `restore-buffer-modified-p' before killing?
714 ;;; (with-current-buffer created-buf
715 ;;; (restore-buffer-modified-p nil) ; Just visiting can sometimes modify the buffer
716 ;;; (setq icicle-new-bufs-to-kill (delete created-buf icicle-new-bufs-to-kill))
717 ;;; (kill-buffer created-buf)))))
718 (setq icicle-new-bufs-to-kill (delete created-buf icicle-new-bufs-to-kill))
719 (kill-buffer created-buf))))
720
721 ;; Visit properly (mode, vars, handlers, hooks).
722 (let ((fn (if r-o
723 (if ,other-window-p #'find-file-read-only-other-window #'find-file-read-only)
724 (if ,other-window-p #'find-file-other-window #'find-file))))
725 (funcall fn file 'WILDCARDS))
726
727 ;; Add the visited buffers to those we will keep (not kill).
728 ;; For a directory, get the Dired buffer instead of using `get-file-buffer'.
729 (dolist (fil wildfiles)
730 (when (setq fil (if (file-directory-p fil)
731 (get-buffer (file-name-nondirectory fil))
732 (get-file-buffer fil)))
733 (push fil icicle-new-bufs-to-keep))))))
734
735 (defmacro icicle-find-file-of-content-action-1 (other-window-p read-only-p)
736 "Action function for commands using `read-file-name' with content searching.
737 Non-nil OTHER-WINDOW-P means use other window.
738 Non-nil READ-ONLY-P means visit file in read-only mode."
739 ;; FREE VARS here: CURRENT-PREFIX-ARG, THIS-COMMAND, `icicle-new-bufs-to-kill', `icicle-new-bufs-to-keep'.
740 `(lambda (file) ; Action function
741 (setq file (icicle-transform-multi-completion file))
742 (setq file (if (string= "" (file-name-nondirectory file)) (directory-file-name file) file))
743 (let* ((r-o (or ,read-only-p
744 (and (memq this-command '(icicle-candidate-action icicle-mouse-candidate-action
745 icicle-all-candidates-action))
746 current-prefix-arg))) ; Use this, not `icicle-pref-arg': for this candidate.
747 ;; If FILE uses wildcards then there are multiple files to visit.
748 (wildfiles (file-expand-wildcards file)))
749
750 ;; For each matching file name, kill any buffers created for content-searching it, so that
751 ;; `find-file*' DTRT wrt file-local variable declarations, file handlers, find-file hooks etc.
752 (dolist (fil wildfiles)
753 (let ((created-buf (car (memq (find-buffer-visiting fil) icicle-new-bufs-to-kill))))
754 (when (and (buffer-live-p created-buf) (not (memq created-buf icicle-new-bufs-to-keep)))
755 ;;; $$$$$$ Why were we calling `restore-buffer-modified-p' before killing?
756 ;;; (with-current-buffer created-buf
757 ;;; (restore-buffer-modified-p nil) ; Just visiting can sometimes modify the buffer
758 ;;; (setq icicle-new-bufs-to-kill (delete created-buf icicle-new-bufs-to-kill))
759 ;;; (kill-buffer created-buf)))))
760 (setq icicle-new-bufs-to-kill (delete created-buf icicle-new-bufs-to-kill))
761 (kill-buffer created-buf))))
762
763 ;; Visit properly (mode, vars, handlers, hooks).
764 (icicle-find-file-or-expand-dir file #'icicle-find-file-of-content-1 r-o ,other-window-p)
765
766 ;; Add the visited buffers to those we will keep (not kill).
767 ;; For a directory, get the Dired buffer instead of using `get-file-buffer'.
768 (dolist (fil wildfiles)
769 (when (setq fil (if (file-directory-p fil)
770 (get-buffer (file-name-nondirectory fil))
771 (get-file-buffer fil)))
772 (push fil icicle-new-bufs-to-keep))))))
773
774 ;;(@* "Icicles Top-Level Commands, Part 1")
775
776 ;;; Icicles Top-Level Commands, Part 1 -------------------------------
777
778
779 ;; REPLACE ORIGINAL `pp-eval-expression' defined in `pp.el',
780 ;; saving it for restoration when you toggle `icicle-mode'.
781 ;;
782 ;; This is essentially the same as `pp-eval-expression' defined in `pp+.el'.
783 ;;
784 ;; 1. Read with completion, using `icicle-read-expression-map'.
785 ;; 2. Progress message added.
786 ;; 3. Added optional arg and insertion behavior.
787 ;; 4. Respect `icicle-pp-eval-expression-print-length', `icicle-pp-eval-expression-print-level',
788 ;; and `eval-expression-debug-on-error'.
789 ;; 5. Adjusted to work in different Emacs releases.
790 ;;
791 (defun icicle-pp-eval-expression (expression ; Bound to `M-:' in Icicle mode.
792 &optional insert-value)
793 "Evaluate Emacs-Lisp sexp EXPRESSION, and pretty-print its value.
794 Add the value to the front of the variable `values'.
795 With a prefix arg, insert the value into the current buffer at point.
796 With a negative prefix arg, if the value is a string, then insert it
797 into the buffer without double-quotes (`\"').
798 With no prefix arg:
799 If the value fits on one line (frame width) show it in the echo area.
800 Otherwise, show the value in buffer `*Pp Eval Output*'.
801
802 This command respects user options
803 `icicle-pp-eval-expression-print-length',
804 `icicle-pp-eval-expression-print-level', and
805 `eval-expression-debug-on-error'.
806
807 Emacs-Lisp mode completion and indentation bindings are in effect.
808
809 By default, Icicle mode remaps all key sequences that are normally
810 bound to `eval-expression' or `pp-eval-expression' to
811 `icicle-pp-eval-expression'. If you do not want this remapping, then
812 customize option `icicle-top-level-key-bindings'."
813 (interactive
814 (list (read-from-minibuffer "Eval: " nil icicle-read-expression-map t 'read-expression-history)
815 current-prefix-arg))
816 (message "Evaluating...")
817 (if (or (not (boundp 'eval-expression-debug-on-error))
818 (null eval-expression-debug-on-error))
819 (setq values (cons (eval expression) values))
820 (let ((old-value (make-symbol "t"))
821 new-value)
822 ;; Bind `debug-on-error' to something unique so that we can detect when evaled code changes it.
823 (let ((debug-on-error old-value))
824 (setq values (cons (eval expression) values)
825 new-value debug-on-error))
826 ;; If evaled code has changed the value of `debug-on-error', propagate that change to the global binding.
827 (unless (eq old-value new-value)
828 (setq debug-on-error new-value))))
829 (let ((print-length icicle-pp-eval-expression-print-length)
830 (print-level icicle-pp-eval-expression-print-level)
831 (deactivate-mark nil))
832 (cond (insert-value
833 (message "Evaluating...done. Value inserted.")
834 (setq insert-value (prefix-numeric-value insert-value))
835 (if (or (not (stringp (car values))) (wholenump insert-value))
836 (pp (car values) (current-buffer))
837 (princ (car values) (current-buffer))))
838 (t (icicle-pp-display-expression (car values) "*Pp Eval Output*")))))
839
840
841 ;; REPLACE ORIGINAL in `pp.el':
842 ;;
843 ;; 1. Use no `emacs-lisp-mode-hook' or `change-major-mode-hook'.
844 ;; 2. Call `font-lock-fontify-buffer'.
845 ;;
846 ;; Same as `pp-display-expression' definition in `pp+.el'.
847 ;;
848 (defun icicle-pp-display-expression (expression out-buffer-name)
849 "Prettify and show EXPRESSION in a way appropriate to its length.
850 If a temporary buffer is needed for representation, it is named
851 OUT-BUFFER-NAME."
852 (let* ((old-show-function temp-buffer-show-function)
853 ;; Use this function to display the buffer.
854 ;; This function either decides not to display it at all
855 ;; or displays it in the usual way.
856 (temp-buffer-show-function
857 `(lambda (buf)
858 (with-current-buffer buf
859 (goto-char (point-min))
860 (end-of-line 1)
861 (if (or (< (1+ (point)) (point-max))
862 (>= (- (point) (point-min)) (frame-width)))
863 (let ((temp-buffer-show-function ',old-show-function)
864 (old-selected (selected-window))
865 (window (display-buffer buf)))
866 (goto-char (point-min)) ; expected by some hooks ...
867 (make-frame-visible (window-frame window))
868 (unwind-protect
869 (progn (select-window window)
870 (run-hooks 'temp-buffer-show-hook))
871 (when (window-live-p old-selected) (select-window old-selected))
872 (message "Evaluating...done. See buffer `%s'."
873 out-buffer-name)))
874 (message "%s" (buffer-substring (point-min) (point))))))))
875 (with-output-to-temp-buffer out-buffer-name
876 (pp expression)
877 (with-current-buffer standard-output
878 (setq buffer-read-only nil)
879 ;; Avoid `let'-binding because `change-major-mode-hook' is local.
880 ;; IOW, avoid this runtime message:
881 ;; "Making change-major-mode-hook buffer-local while locally let-bound!"
882 ;; Suggestion from Stefan M.: Can just set these hooks instead of binding,
883 ;; because they are not permanent-local. They'll be emptied and
884 ;; repopulated as needed by the call to emacs-lisp-mode.
885 (set (make-local-variable 'emacs-lisp-mode-hook) nil)
886 (set (make-local-variable 'change-major-mode-hook) nil)
887 (emacs-lisp-mode)
888 (set (make-local-variable 'font-lock-verbose) nil)
889 (font-lock-fontify-buffer)))))
890
891 (defun icicle-shell-command-on-file (file)
892 "Read a shell command and invoke it, passing FILE as an argument."
893 (dired-run-shell-command
894 (dired-shell-stuff-it (icicle-read-shell-command (format "! on `%s': " file)) (list file) nil)))
895
896 (defun icicle-recompute-shell-command-candidates (&optional savep)
897 "Update option `icicle-shell-command-candidates-cache'.
898 Recompute the available shell commands using your search path.
899 Return the new option value.
900 With a prefix argument, the updated option is saved persistently.
901
902 If the value of option `icicle-guess-commands-in-path' is not `load',
903 then turning on Icicle mode (again) resets the cache value to ().
904 If the value of `icicle-guess-commands-in-path' is `first-use', then
905 the cache is updated when you next use it, but it is not saved."
906 (interactive "P")
907 (setq icicle-shell-command-candidates-cache (icicle-compute-shell-command-candidates))
908 (when savep (funcall icicle-customize-save-variable-function
909 'icicle-shell-command-candidates-cache
910 icicle-shell-command-candidates-cache))
911 icicle-shell-command-candidates-cache)
912
913
914 ;; REPLACE ORIGINAL `comint-completion-at-point' defined in `comint.el',
915 ;; saving it for restoration when you toggle `icicle-mode'.
916 ;;
917 (when (> emacs-major-version 23)
918 (defalias 'icicle-comint-completion-at-point 'icicle-comint-dynamic-complete))
919
920
921 ;; REPLACE ORIGINAL `comint-dynamic-complete' defined in `comint.el',
922 ;; saving it for restoration when you toggle `icicle-mode'.
923 ;;
924 ;; Use Icicles completion when there are multiple candidates.
925 ;;
926 (defun icicle-comint-dynamic-complete () ; Bound to `TAB' in Comint (and Shell) mode.
927 "Dynamically perform completion at point.
928 Calls the functions in `comint-dynamic-complete-functions', but with
929 Icicles functions substituted, to perform completion until a function
930 returns non-nil. Return that value."
931 (interactive)
932 ;; Need a symbol for `run-hook-with-args-until-success', so bind one.
933 (let ((hook (icicle-comint-replace-orig-completion-fns)))
934 (run-hook-with-args-until-success 'hook)))
935
936 (defun icicle-comint-replace-orig-completion-fns ()
937 "Return `comint-dynamic-complete-functions', but with Icicles functions.
938 Get the Icicles functions from option
939 `icicle-comint-dynamic-complete-replacements'.
940
941 Only one (the first matching) replacement is made for any function."
942 (let ((result ())
943 (replacements (copy-sequence icicle-comint-dynamic-complete-replacements)))
944 (dolist (fn comint-dynamic-complete-functions)
945 (catch 'c-d-c-f-replacements-loop
946 (dolist (rep replacements)
947 (when (or (eq (car rep) fn)
948 (and (listp (car rep)) (memq fn (car rep))))
949 (push (eval (cadr rep)) result)
950 (unless (eq (car rep) fn) (push fn result))
951 (setq replacements (delete rep replacements)) ; For ((a b c) 'NEW), put NEW in front of only one.
952 (throw 'c-d-c-f-replacements-loop nil))) ; Allow only one replacement.
953 (push fn result)))
954 (nreverse result)))
955
956 (defun icicle-comint-dynamic-complete-filename (&optional replace-to-eol-p)
957 "Dynamically complete the file name before point, using Icicles completion.
958 Similar to `comint-replace-by-expanded-filename', except that this
959 does not change parts of the file name already in the buffer before
960 point. It just appends completion characters at point.
961
962 Return t if successful, nil otherwise.
963
964 With a prefix arg, replace the rest of the line after point with the
965 completion choice. Otherwise, replace only the filename-matching text
966 before point.
967
968 Completion is dependent on the value of `comint-completion-addsuffix',
969 `comint-completion-recexact' and `comint-completion-fignore', and the
970 timing of completions listing is dependent on the value of
971 `comint-completion-autolist'. See also
972 `comint-match-partial-filename' and
973 `icicle-comint-dynamic-complete-as-filename'."
974 (interactive "P")
975 (require 'comint)
976 (when (comint-match-partial-filename)
977 (unless (window-minibuffer-p (selected-window)) (message "Completing file name..."))
978 (icicle-comint-dynamic-complete-as-filename replace-to-eol-p)))
979
980 (defun icicle-comint-dynamic-complete-as-filename (&optional replace-to-eol-p)
981 "Dynamically complete at point as a filename.
982 Optional arg REPLACE-TO-EOL-P non-nil means replace the rest of the
983 line after point with the completion choice.
984 Return t if successful.
985 See `icicle-comint-dynamic-complete-filename'."
986 (lexical-let* ((completion-ignore-case (if (boundp 'read-file-name-completion-ignore-case)
987 read-file-name-completion-ignore-case
988 (memq system-type '(ms-dos windows-nt cygwin))))
989 (completion-ignored-extensions comint-completion-fignore)
990 (minibuffer-p (window-minibuffer-p (selected-window)))
991 (success t)
992 (dirsuffix (cond ((not comint-completion-addsuffix) "")
993 ((not (consp comint-completion-addsuffix)) "/")
994 (t (car comint-completion-addsuffix))))
995 (filesuffix (cond ((not comint-completion-addsuffix) "")
996 ((not (consp comint-completion-addsuffix)) " ")
997 (t (cdr comint-completion-addsuffix))))
998 (filename (comint-match-partial-filename))
999 (filename-beg (if filename (match-beginning 0) (point)))
1000 (filename-end (if filename
1001 (if replace-to-eol-p
1002 (line-end-position)
1003 (match-end 0))
1004 (point)))
1005 (filename (or filename ""))
1006 (filedir (file-name-directory filename))
1007 (filenondir (file-name-nondirectory filename))
1008 (directory (if filedir (comint-directory filedir) default-directory))
1009 (completion (file-name-completion filenondir directory)))
1010 (cond ((null completion)
1011 (if minibuffer-p
1012 (minibuffer-message (format " [No completions of `%s']" filename))
1013 (message "No completions of `%s'" filename))
1014 (setq success nil))
1015 ((eq completion t) ; Already completed: "the-file".
1016 (insert filesuffix)
1017 (unless minibuffer-p (message "Sole completion")))
1018 ((string-equal completion "") ; A directory: "dir/" - complete it.
1019 (icicle-condition-case-no-debug nil
1020 (let* ((icicle-show-Completions-initially-flag t)
1021 (icicle-incremental-completion-p 'display)
1022 (icicle-top-level-when-sole-completion-flag t)
1023 (enable-recursive-minibuffers t)
1024 (choice
1025 (save-excursion
1026 (save-window-excursion (read-file-name "Complete: " directory nil t)))))
1027 (when (and choice (not (string= choice directory)))
1028 (insert (comint-quote-filename
1029 (directory-file-name (file-relative-name choice directory))))
1030 (insert (if (file-directory-p choice) dirsuffix filesuffix))
1031 (when replace-to-eol-p (delete-region (point) (line-end-position)))))
1032 (error nil)))
1033 (t ; COMPLETION is the common prefix string.
1034 (let ((file (concat (file-name-as-directory directory) completion))
1035 (use-dialog-box nil)) ; Inhibit use of open-file dialog box if called from menu.
1036 ;; Insert completion. The completion string might have a different case from
1037 ;; what's in the prompt, if `read-file-name-completion-ignore-case' is non-nil.
1038 (delete-region filename-beg filename-end)
1039 (when filedir (insert (comint-quote-filename filedir)))
1040 (insert (comint-quote-filename (directory-file-name completion)))
1041 (cond ((symbolp (file-name-completion completion directory))
1042 ;; We inserted a unique completion. Add suffix.
1043 (insert (if (file-directory-p file) dirsuffix filesuffix))
1044 (unless minibuffer-p (message "Completed")))
1045 ((and comint-completion-recexact comint-completion-addsuffix
1046 (string-equal filenondir completion)
1047 (or (icicle-file-remote-p file) ; Don't let Tramp try to access it.
1048 (file-exists-p file)))
1049 ;; It's not unique, but user wants shortest match.
1050 (insert (if (file-directory-p file) dirsuffix filesuffix))
1051 (unless minibuffer-p (message "Completed shortest")))
1052 ;; It's not unique. Let user choose a completion.
1053 ((or comint-completion-autolist (string-equal filenondir completion))
1054 (icicle-condition-case-no-debug nil
1055 (let* ((icicle-show-Completions-initially-flag t)
1056 (icicle-incremental-completion-p 'display)
1057 (icicle-top-level-when-sole-completion-flag t)
1058 (enable-recursive-minibuffers t)
1059 (choice
1060 (save-excursion
1061 (save-window-excursion
1062 (read-file-name
1063 "Complete: " directory completion nil completion
1064 (and (> emacs-major-version 21)
1065 (lambda (f) (string-match completion f)))))))) ; FREE: COMPLETION.
1066 (when choice
1067 (delete-backward-char (length completion))
1068 (insert (comint-quote-filename
1069 (directory-file-name (file-relative-name choice directory))))
1070 (insert (if (file-directory-p choice) dirsuffix filesuffix))))
1071 (error nil)))
1072 (t (unless minibuffer-p (message "Partially completed")))))))
1073 success))
1074
1075 (defun icicle-shell-dynamic-complete-command ()
1076 "Dynamically complete the command at point.
1077 Similar to `icicle-comint-dynamic-complete-filename', but this
1078 searches `exec-path' (minus the trailing Emacs library path) for
1079 completion candidates. Note that this may not be the same as the
1080 shell's idea of the path.
1081
1082 Completion is dependent on the value of `shell-completion-execonly',
1083 plus those that effect file completion.
1084 See `icicle-shell-dynamic-complete-as-command'.
1085
1086 Return t if successful.
1087
1088 Uses Icicles completion."
1089 (interactive)
1090 (let ((filename (comint-match-partial-filename)))
1091 (when (and filename
1092 (save-match-data (not (string-match "[~/]" filename)))
1093 (eq (match-beginning 0) (save-excursion (shell-backward-command 1) (point))))
1094 (prog2 (unless (window-minibuffer-p (selected-window))
1095 (message "Completing command name..."))
1096 (icicle-shell-dynamic-complete-as-command)))))
1097
1098 (defun icicle-shell-dynamic-complete-as-command ()
1099 "Dynamically complete text at point as a command.
1100 See `icicle-shell-dynamic-complete-filename'.
1101 Return t if successful."
1102 (let* ((filename (or (comint-match-partial-filename) ""))
1103 (filenondir (file-name-nondirectory filename))
1104 (path-dirs (cdr (reverse exec-path)))
1105 (cwd (file-name-as-directory (expand-file-name default-directory)))
1106 (ignored-extensions
1107 (and comint-completion-fignore
1108 (mapconcat (lambda (x) (concat (regexp-quote x) "$")) comint-completion-fignore "\\|")))
1109 (dir "")
1110 (comps-in-dir ())
1111 (file "")
1112 (abs-file-name "")
1113 (completions ()))
1114 (while path-dirs ; Go thru each dir in the search path, finding completions.
1115 (setq dir (file-name-as-directory (comint-directory (or (car path-dirs) ".")))
1116 comps-in-dir (and (file-accessible-directory-p dir)
1117 (file-name-all-completions filenondir dir)))
1118 (while comps-in-dir ; Go thru each completion, to see whether it should be used.
1119 (setq file (car comps-in-dir)
1120 abs-file-name (concat dir file))
1121 (when (and (not (member file completions))
1122 (not (and ignored-extensions (string-match ignored-extensions file)))
1123 (or (string-equal dir cwd) (not (file-directory-p abs-file-name)))
1124 (or (null shell-completion-execonly) (file-executable-p abs-file-name)))
1125 (setq completions (cons file completions)))
1126 (setq comps-in-dir (cdr comps-in-dir)))
1127 (setq path-dirs (cdr path-dirs)))
1128 (let ((success (let ((comint-completion-addsuffix nil)
1129 (icicle-candidate-help-fn
1130 (lambda (cand)
1131 (with-output-to-temp-buffer "*Help*"
1132 (princ (shell-command-to-string (concat "apropos "
1133 (shell-quote-argument cand))))))))
1134 (icicle-comint-dynamic-simple-complete filenondir completions))))
1135 (when (and (memq success '(sole shortest)) comint-completion-addsuffix
1136 (not (file-directory-p (comint-match-partial-filename))))
1137 (insert " "))
1138 success)))
1139
1140 (defun icicle-comint-replace-by-expanded-filename (&optional replace-to-eol-p)
1141 "Dynamically complete, expand, and canonicalize the filename at point.
1142 With a prefix arg, replace everthing past point on the current line.
1143 Otherwise, replace only the filename-matching text before point.
1144
1145 Like vanilla `comint-replace-by-expanded-filename', but uses Icicles
1146 completion."
1147 (interactive "P")
1148 (let ((filename (comint-match-partial-filename)))
1149 (when filename
1150 (replace-match (expand-file-name filename) t t)
1151 (icicle-comint-dynamic-complete-filename replace-to-eol-p))))
1152
1153 (defun icicle-comint-dynamic-simple-complete (stub candidates)
1154 "Dynamically complete STUB from CANDIDATES list.
1155 Inserts completion characters at point by completing STUB from the
1156 strings in CANDIDATES. Uses Icicles completion if completion is
1157 ambiguous.
1158
1159 Return nil if no completion was inserted.
1160 Return `sole' if completed with the only completion match.
1161 Return `shortest' if completed with the shortest match.
1162 Return `partial' if completed as far as possible.
1163 Return `listed' if a completion listing was shown.
1164
1165 See also `icicle-comint-dynamic-complete-filename'."
1166 (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt cygwin)))
1167 (minibuffer-p (window-minibuffer-p (selected-window)))
1168 (suffix (cond ((not comint-completion-addsuffix) "")
1169 ((not (consp comint-completion-addsuffix)) " ")
1170 (t (cdr comint-completion-addsuffix))))
1171 (candidates (mapcar #'list candidates))
1172 (completions (all-completions stub candidates)))
1173 (cond ((null completions)
1174 (if minibuffer-p
1175 (minibuffer-message (format " [No completions of `%s']" stub))
1176 (message "No completions of `%s'" stub))
1177 nil)
1178 ((= 1 (length completions))
1179 (let ((completion (car completions)))
1180 (if (string-equal completion stub)
1181 (unless minibuffer-p (message "Sole completion"))
1182 (insert (substring completion (length stub)))
1183 (unless minibuffer-p (message "Completed")))
1184 (insert suffix)
1185 'sole))
1186 (t ; There's no unique completion.
1187 (let ((completion (try-completion stub candidates))
1188 (enable-recursive-minibuffers t))
1189 ;; Insert the longest substring.
1190 (insert (substring completion (length stub)))
1191 (cond ((and comint-completion-recexact comint-completion-addsuffix
1192 (string-equal stub completion)
1193 (member completion completions))
1194 (insert suffix) ; Not unique but user wants shortest match.
1195 (unless minibuffer-p (message "Completed shortest"))
1196 'shortest)
1197 ((or comint-completion-autolist (string-equal stub completion))
1198 (icicle-condition-case-no-debug nil ; Let user choose a completion.
1199 (let* ((icicle-show-Completions-initially-flag t)
1200 (icicle-incremental-completion-p 'display)
1201 (icicle-top-level-when-sole-completion-flag t)
1202 (choice (save-excursion
1203 (completing-read "Complete: " (mapcar #'list completions)
1204 nil t nil nil completion))))
1205 (when choice
1206 (delete-backward-char (length completion))
1207 (insert choice suffix)))
1208 (error nil))
1209 'listed)
1210 (t
1211 (unless minibuffer-p (message "Partially completed"))
1212 'partial)))))))
1213
1214 (defun icicle-shell-dynamic-complete-filename ()
1215 "Dynamically complete the filename at point.
1216 Completes only if point is at a suitable position for a filename
1217 argument."
1218 (interactive)
1219 (let ((opoint (point))
1220 (beg (comint-line-beginning-position)))
1221 (when (save-excursion
1222 (goto-char (if (re-search-backward "[;|&]" beg t) (match-end 0) beg))
1223 (re-search-forward "[^ \t][ \t]" opoint t))
1224 (icicle-comint-dynamic-complete-as-filename))))
1225
1226 (defun icicle-shell-dynamic-complete-environment-variable ()
1227 "`shell-dynamic-complete-environment-variable' but uses Icicles completion."
1228 (interactive)
1229 (require 'shell)
1230 (let ((variable (shell-match-partial-variable)))
1231 (when (and variable (string-match "^\\$" variable))
1232 (prog2 (unless (window-minibuffer-p (selected-window))
1233 (message "Completing variable name..."))
1234 (icicle-shell-dynamic-complete-as-environment-variable)))))
1235
1236 (defun icicle-shell-dynamic-complete-as-environment-variable ()
1237 "`shell-dynamic-complete-as-environment-variable' but uses Icicles completion."
1238 (require 'shell)
1239 (let* ((var (or (shell-match-partial-variable) ""))
1240 (variable (substring var (or (string-match "[^$({]\\|$" var) 0)))
1241 (variables (mapcar (lambda (x) (substring x 0 (string-match "=" x)))
1242 process-environment))
1243 (addsuffix comint-completion-addsuffix)
1244 (comint-completion-addsuffix nil)
1245 (success (icicle-comint-dynamic-simple-complete variable variables)))
1246 (when (memq success '(sole shortest))
1247 (let* ((var (shell-match-partial-variable))
1248 (variable (substring var (string-match "[^$({]" var)))
1249 (protection (cond ((string-match "{" var) "}")
1250 ((string-match "(" var) ")")
1251 (t "")))
1252 (suffix (cond ((null addsuffix) "")
1253 ((file-directory-p (comint-directory (getenv variable))) "/")
1254 (t " "))))
1255 (insert protection suffix)))
1256 success))
1257
1258
1259 ;; Save vanilla `file' widget as `icicle-ORIG-file' widget, for restoring when you quit Icicle mode.
1260 (unless (get 'icicle-ORIG-file 'widget-type)
1261 (put 'icicle-ORIG-file 'widget-type (get 'file 'widget-type))
1262 (put 'icicle-ORIG-file 'widget-documentation (get 'file 'widget-documentation)))
1263
1264 (define-widget 'icicle-file 'string
1265 "Icicles version of the `file' widget.
1266 Reads a file name from an editable text field, with Icicles completion."
1267 ;; `icicle-widget-file-complete' handles both nil and non-nil `icicle-mode'.
1268 ;; Use the following instead of:
1269 ;; :completions #'completion-file-name-table
1270 :complete-function #'icicle-widget-file-complete
1271 :prompt-value 'widget-file-prompt-value
1272 :format "%{%t%}: %v"
1273 ;; Vanilla Emacs comment: This does not work well with terminating newline.
1274 ;; :value-face 'widget-single-line-field
1275 :tag "File")
1276
1277 (defun icicle-widget-file-complete (&optional replace-to-eol-p)
1278 "Perform Icicles completion on the file name at point.
1279 Like `widget-file-complete' (`widget-complete', for Emacs 24+), but
1280 allows Icicles completion.
1281
1282 With a prefix arg, replace everthing past point on the current line.
1283 Otherwise, replace only the filename-matching text before point."
1284 (interactive "P")
1285 (if (and (boundp 'icicle-mode) icicle-mode)
1286 (let ((comint-completion-addsuffix nil)) ; Do not append a space.
1287 (icicle-comint-dynamic-complete-filename replace-to-eol-p))
1288 (cond ((> emacs-major-version 23)
1289 ;; Vanilla Emacs 24+ `file' widget just has this:
1290 ;; :completions #'completion-file-name-table
1291 ;; But we need the equivalent using `:complete-function', not `:completions'.
1292 ;; This is it - this is in fact the Emacs 23 `widget-file-complete'.
1293 ;; See `widget-default-completions' for the relations between keywords
1294 ;; `:completions' and `:complete-function'.
1295 (let* ((field (widget-field-find (point)))
1296 (start (widget-field-start field))
1297 (end (max (point) (widget-field-text-end field))))
1298 (completion-in-region start end #'completion-file-name-table)))
1299 (t
1300 (widget-file-complete)))))
1301
1302 (defun icicle-gud-gdb-complete-command (&optional command a b)
1303 "`gud-gdb-complete-command', but uses Icicles completion.
1304 Perform completion on the GDB command preceding point."
1305 (interactive)
1306 (if command
1307 (setq command (concat "p " command)) ; Used by gud-watch in mini-buffer.
1308 (let ((end (point))) ; Used in GUD buffer.
1309 (setq command (buffer-substring (comint-line-beginning-position) end))))
1310 (let* ((command-word
1311 ;; Find the word break. This match will always succeed.
1312 (and (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
1313 (substring command (match-beginning 2))))
1314 (complete-list
1315 (gud-gdb-run-command-fetch-lines (concat "complete " command)
1316 (current-buffer)
1317 ;; From string-match above.
1318 (match-beginning 2))))
1319 ;; Protect against old versions of GDB.
1320 (and complete-list
1321 (string-match "^Undefined command: \"complete\"" (car complete-list))
1322 (icicle-user-error "This version of GDB does not support command `complete'"))
1323 ;; Sort the list like readline.
1324 (setq complete-list (sort complete-list (function string-lessp)))
1325 ;; Remove duplicates.
1326 (let ((first complete-list)
1327 (second (cdr complete-list)))
1328 (while second
1329 (if (string-equal (car first) (car second))
1330 (setcdr first (setq second (cdr second)))
1331 (setq first second
1332 second (cdr second)))))
1333 ;; Add a trailing single quote if there is a unique completion
1334 ;; and it contains an odd number of unquoted single quotes.
1335 (and (= (length complete-list) 1)
1336 (let ((str (car complete-list))
1337 (pos 0)
1338 (count 0))
1339 (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos)
1340 (setq count (1+ count)
1341 pos (match-end 0)))
1342 (and (= (mod count 2) 1)
1343 (setq complete-list (list (concat str "'"))))))
1344 ;; Let comint handle the rest.
1345 (icicle-comint-dynamic-simple-complete command-word complete-list)))
1346
1347
1348 (defvar icicle-dabbrev--last-obarray nil
1349 "Last obarray of completions used by `icicle-dabbrev-completion'.")
1350
1351 (defvar icicle-dabbrev--last-completion-buffer nil
1352 "Buffer last completed in by `icicle-dabbrev-completion'.")
1353
1354
1355 ;; REPLACE ORIGINAL `dabbrev-completion' defined in `dabbrev.el',
1356 ;; saving it for restoration when you toggle `icicle-mode'.
1357 ;;
1358 ;; You can complete from an empty abbrev also.
1359 ;; Uses Icicles completion when there are multiple candidates.
1360 ;;
1361 (when (and (fboundp 'dabbrev-completion) (not (fboundp 'icicle-ORIG-dabbrev-completion)))
1362 (defalias 'icicle-ORIG-dabbrev-completion (symbol-function 'dabbrev-completion)))
1363
1364 (defun icicle-dabbrev-completion (&optional arg) ; Bound to `C-M-/' globally.
1365 "Complete current word in buffer.
1366 Like \\[dabbrev-expand], but finds all expansions in the current buffer
1367 and presents suggestions for completion.
1368
1369 With a prefix argument, it searches all buffers accepted by
1370 `dabbrev-friend-buffer-function', to find the completions.
1371
1372 If the prefix argument is 16 (which comes from `C-u C-u'), then it
1373 searches *ALL* buffers.
1374
1375 With no prefix argument, it reuses an old completion list
1376 if there is a suitable one already."
1377 (interactive "*P")
1378 (unless (featurep 'dabbrev)
1379 (unless (require 'dabbrev nil t) (error "Library `dabbrev' not found"))
1380 (icicle-mode 1)) ; Redefine `dabbrev-completion' to Icicles version.
1381 (dabbrev--reset-global-variables)
1382 (let* ((dabbrev-check-other-buffers (and arg t)) ; Must be t
1383 (dabbrev-check-all-buffers (and arg (= (prefix-numeric-value arg) 16)))
1384 (abbrev (icicle-dabbrev--abbrev-at-point))
1385 (ignore-case-p (and (if (eq dabbrev-case-fold-search 'case-fold-search)
1386 case-fold-search
1387 dabbrev-case-fold-search)
1388 (or (not dabbrev-upcase-means-case-search)
1389 (string= abbrev (downcase abbrev)))))
1390 (my-obarray icicle-dabbrev--last-obarray)
1391 init)
1392 (save-excursion ; If new abbreviation to expand then expand it.
1393 (unless (and (null arg) ; Reuse existing completions, if appropriate.
1394 my-obarray
1395 (or (eq icicle-dabbrev--last-completion-buffer (current-buffer))
1396 (and (window-minibuffer-p (selected-window))
1397 (eq icicle-dabbrev--last-completion-buffer
1398 (window-buffer (minibuffer-selected-window)))))
1399 dabbrev--last-abbreviation
1400 (>= (length abbrev) (length dabbrev--last-abbreviation))
1401 (string= dabbrev--last-abbreviation
1402 (substring abbrev 0 (length dabbrev--last-abbreviation)))
1403 (setq init (try-completion abbrev my-obarray)))
1404 (setq dabbrev--last-abbreviation abbrev)
1405 (let ((completion-list (dabbrev--find-all-expansions abbrev ignore-case-p))
1406 (completion-ignore-case ignore-case-p))
1407 ;; Make an obarray with all expansions
1408 (setq my-obarray (make-vector (length completion-list) 0))
1409 (unless (> (length my-obarray) 0)
1410 (icicle-user-error "No dynamic expansion for \"%s\" found%s" abbrev
1411 (if dabbrev--check-other-buffers "" " in this-buffer")))
1412 (dolist (string completion-list)
1413 (cond ((or (not ignore-case-p) (not dabbrev-case-replace))
1414 (intern string my-obarray))
1415 ((string= abbrev (icicle-upcase abbrev))
1416 (intern (icicle-upcase string) my-obarray))
1417 ((string= (substring abbrev 0 1) (icicle-upcase (substring abbrev 0 1)))
1418 (intern (capitalize string) my-obarray))
1419 (t (intern (downcase string) my-obarray))))
1420 (setq icicle-dabbrev--last-obarray my-obarray
1421 icicle-dabbrev--last-completion-buffer (current-buffer)
1422 ;; Find the expanded common string.
1423 init (try-completion abbrev my-obarray)))))
1424 ;; Let the user choose between the expansions
1425 (unless (stringp init) (setq init abbrev))
1426 (cond
1427 ((and (not (string-equal init ""))
1428 (not (string-equal (downcase init) (downcase abbrev)))
1429 (<= (length (all-completions init my-obarray)) 1))
1430 (message "Completed (no other completions)")
1431 (if (< emacs-major-version 21)
1432 (dabbrev--substitute-expansion nil abbrev init)
1433 (dabbrev--substitute-expansion nil abbrev init nil))
1434 (when (window-minibuffer-p (selected-window)) (message nil)))
1435 ;;$$ ;; Complete text only up through the common root. NOT USED.
1436 ;; ((and icicle-dabbrev-stop-at-common-root-p
1437 ;; (not (string-equal init ""))
1438 ;; (not (string-equal (downcase init) (downcase abbrev))))
1439 ;; (message "Use `%s' again to complete further"
1440 ;; (icicle-key-description (this-command-keys) nil
1441 ;; icicle-key-descriptions-use-<>-flag))
1442 ;; (if (< emacs-major-version 21)
1443 ;; (dabbrev--substitute-expansion nil abbrev init)
1444 ;; (dabbrev--substitute-expansion nil abbrev init nil))
1445 ;; (when (window-minibuffer-p (selected-window)) (message nil))) ; $$ NEEDED?
1446 (t
1447 ;; String is a common root already. Use Icicles completion.
1448 (icicle-highlight-lighter)
1449 (message "Making completion list...")
1450 (search-backward abbrev)
1451 (replace-match "")
1452 (condition-case nil
1453 (let* ((icicle-show-Completions-initially-flag t)
1454 (icicle-incremental-completion-p 'display)
1455 (minibuffer-completion-table my-obarray)
1456 (choice
1457 (completing-read "Complete: " my-obarray nil nil init nil init)))
1458 (when choice (insert choice)))
1459 (quit (insert abbrev)))))))
1460
1461 (defun icicle-dabbrev--abbrev-at-point ()
1462 "Like `dabbrev--abbrev-at-point', but returns \"\" if there is no match.
1463 Vanilla `dabbrev--abbrev-at-point' raises an error if no match."
1464 (let ((abv ""))
1465 (setq dabbrev--last-abbrev-location (point)) ; Record the end of the abbreviation.
1466 (unless (bobp)
1467 (save-excursion ; Return abbrev at point
1468 ;; If we aren't right after an abbreviation, move point back to just after one.
1469 ;; This is so the user can get successive words by typing the punctuation followed by M-/.
1470 (save-match-data
1471 (when (and (save-excursion
1472 (forward-char -1)
1473 (not (looking-at
1474 (concat "\\(" (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_") "\\)+"))))
1475 (re-search-backward (or dabbrev-abbrev-char-regexp "\\sw\\|\\s_") nil t))
1476 (forward-char 1)))
1477 (dabbrev--goto-start-of-abbrev) ; Now find the beginning of that one.
1478 (setq abv (buffer-substring-no-properties dabbrev--last-abbrev-location (point)))))
1479 abv))
1480
1481
1482 ;; REPLACE ORIGINAL `bbdb-complete-mail' defined in `bbdb-com.el', version 3.02
1483 ;; saving it for restoration when you toggle `icicle-mode'.
1484 ;;
1485 ;; BBDB Version 3.02, the Insidious Big Brother Database, is available here: http://melpa.milkbox.net/.
1486 ;;
1487 ;; Uses Icicles completion when there are multiple candidates.
1488 ;;
1489 ;; Free vars here: `bbdb-*' are bound in `bbdb-com.el'.
1490 (defun icicle-bbdb-complete-mail (&optional start-pos cycle-completion-buffer)
1491 "In a mail buffer, complete the user name or mail address before point.
1492 Completes up to the preceding newline, colon or comma, or the value of
1493 START-POS.
1494 Return non-nil if there is a valid completion, else return nil.
1495 You can control completion behaviour using `bbdb-completion-list'
1496 \(`bbdb-completion-type' in older BBDB versions).
1497
1498 If what has been typed is unique, insert an entry \"User Name
1499 <mail-address>\" - but see `bbdb-mail-allow-redundancy'
1500 \(`bbdb-dwim-net-address-allow-redundancy' in older BBDB versions).
1501 If it is a valid completion but not unique, you can choose from the
1502 list of completions using Icicles completion.
1503
1504 If your input is completed and `bbdb-complete-mail-allow-cycling' is
1505 true (`bbdb-complete-name-allow-cycling' for older BBDB versions),
1506 you can repeat to cycle through the nets for the matching record.
1507
1508 When called with a prefix arg, display a list of all mail messages
1509 available for cycling.
1510
1511 See your version of BBDB for more information."
1512 (interactive (list nil current-prefix-arg))
1513 (unless (and (require 'bbdb nil t) (require 'bbdb-com nil t)
1514 (fboundp 'bbdb-complete-mail))
1515 (icicle-user-error "`icicle-bbdb-complete-mail' requires a BBDB version such as 3.02"))
1516 (bbdb-buffer) ; Make sure database is initialized.
1517 (lexical-let* ((end (point))
1518 (beg (or start-pos (save-excursion
1519 (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*")
1520 (goto-char (match-end 0)) (point))))
1521 (orig (buffer-substring beg end))
1522 (typed (downcase orig))
1523 (pattern (bbdb-string-trim typed))
1524 (completion-ignore-case t)
1525 (completion (try-completion pattern bbdb-hashtable #'bbdb-completion-predicate))
1526 (all-the-completions ())
1527 dwim-completions one-record done)
1528 ;; [:,] match would be interpreted as START-POS (e.g., a comma in LF-NAME). Compensate.
1529 (when (and (stringp completion) (string-match "[:,]" completion))
1530 (setq completion (substring completion 0 (match-beginning 0))))
1531 ;; Cannot use `all-completions' to set `all-the-completions' because it converts symbols to strings.
1532 (all-completions pattern bbdb-hashtable (lambda (sym)
1533 (when (bbdb-completion-predicate sym)
1534 (push sym all-the-completions))))
1535 ;; Resolve records matching pattern. Multiple completions could match the same record.
1536 (let ((records (icicle-delete-dups (apply #'append (mapcar #'symbol-value all-the-completions)))))
1537 (setq one-record (and (not (cdr records)) (car records)))) ; Only one matching record.
1538 (icicle-remove-Completions-window)
1539 (cond (one-record
1540 ;; Only one matching record.
1541 ;; Determine mail address of ONE-RECORD to use for ADDRESS.
1542 ;; Do we have a preferential order for the following tests?
1543 (let ((completion-list (if (eq t bbdb-completion-list)
1544 '(fl-name lf-name mail aka organization)
1545 bbdb-completion-list))
1546 (mails (bbdb-record-mail one-record))
1547 mail elt)
1548 (unless mails (error "Matching record has no `mail' field"))
1549 ;; (1) If PATTERN matches name, AKA, or organization of ONE-RECORD,
1550 ;; then ADDRESS is the first mail address of ONE-RECORD.
1551 (when (try-completion pattern (append (and (memq 'fl-name completion-list)
1552 (list (or (bbdb-record-name one-record) "")))
1553 (and (memq 'lf-name completion-list)
1554 (list (or (bbdb-record-name-lf one-record) "")))
1555 (and (memq 'aka completion-list)
1556 (bbdb-record-field one-record 'aka-all))
1557 (and (memq 'organization completion-list)
1558 (bbdb-record-organization one-record))))
1559 (setq mail (car mails)))
1560 ;; (2) If PATTERN matches one or multiple mail addresses of ONE-RECORD,
1561 ;; then we take the first one matching PATTERN.
1562 (unless mail (while (setq elt (pop mails))
1563 (if (try-completion pattern (list elt))
1564 (setq mail elt
1565 mails ()))))
1566 (unless mail (error "`icicle-bbdb-complete-mail': No match for `%s'" pattern)) ; Indicates a bug!
1567 (let ((address (bbdb-dwim-mail one-record mail)))
1568 (if (string= address (buffer-substring-no-properties beg end))
1569 (unless (and bbdb-complete-mail-allow-cycling (< 1 (length (bbdb-record-mail one-record))))
1570 (setq done 'UNCHANGED))
1571 (delete-region beg end) ; Replace text with expansion.
1572 (insert address)
1573 (bbdb-complete-mail-cleanup address)
1574 (setq done 'UNIQUE)))))
1575 ;; Completed partially.
1576 ;; Cannot use trimmed version of pattern here, else recurse infinitely on, e.g., common first names.
1577 ((and (stringp completion) (not (string= typed completion)))
1578 (delete-region beg end)
1579 (insert completion)
1580 (setq done 'PARTIAL))
1581 ;; Partial match not allowing further partial completion.
1582 (completion
1583 (let ((completion-list (if (eq t bbdb-completion-list)
1584 '(fl-name lf-name mail aka organization)
1585 bbdb-completion-list))
1586 sname records)
1587 ;; Collect dwim-addresses for each completion, but only once for each record!
1588 ;; Add if mail is part of the completions.
1589 (dolist (sym all-the-completions)
1590 (setq sname (symbol-name sym))
1591 (dolist (record (symbol-value sym))
1592 (unless (memq record records)
1593 (push record records)
1594 (let ((mails (bbdb-record-mail record))
1595 accept)
1596 (when mails
1597 (dolist (field completion-list)
1598 (if (case field
1599 (fl-name (bbdb-string= sname (bbdb-record-name record)))
1600 (lf-name (bbdb-string= sname (bbdb-cache-lf-name (bbdb-record-cache record))))
1601 (aka (member-ignore-case sname (bbdb-record-field record 'aka-all)))
1602 (organization (member-ignore-case sname (bbdb-record-organization record)))
1603 (primary (bbdb-string= sname (car mails)))
1604 (otherwise nil))
1605 (push (car mails) accept)
1606 (when (eq field 'mail)
1607 (dolist (mail mails)
1608 (when (bbdb-string= sname mail) (push mail accept))))))
1609 (when accept
1610 ;; If DWIM-COMPLETIONS contains only one element, set DONE to `UNIQUE' (see below)
1611 ;; and we want to know ONE-RECORD.
1612 (setq one-record record)
1613 (dolist (mail (delete-dups accept))
1614 (push (bbdb-dwim-mail record mail) dwim-completions))))))))
1615 (cond ((not dwim-completions) (error "No mail address for \"%s\"" orig))
1616 ;; DWIM-COMPLETIONS might contain only one element, if multiple completions match the
1617 ;; same record. In that case proceed with DONE set to `UNIQUE'.
1618 ((eq 1 (length dwim-completions))
1619 (delete-region beg end)
1620 (insert (car dwim-completions))
1621 (bbdb-complete-mail-cleanup (car dwim-completions))
1622 (setq done 'UNIQUE))
1623 (t
1624 (setq done 'CHOOSE))))))
1625 ;; If no completion so far, consider cycling.
1626 ;; Completion is controlled by option `bbdb-completion-list'. Cycling assumes that ORIG already holds
1627 ;; a valid RFC 822 mail address. So cycling can consider different records than completion.
1628 (when (and (not done) bbdb-complete-mail-allow-cycling)
1629 ;; Find the record we are working on.
1630 (let* ((address (mail-extract-address-components orig))
1631 (record (and (listp address) (car (bbdb-message-search (nth 0 address) (nth 1 address)))))
1632 (mails (and record (bbdb-record-mail record))))
1633 (when mails
1634 ;; Cycle, even if MAILS has only one address. `bbdb-dwim-mail' can give something different.
1635 ;; E.g., header "JOHN SMITH <FOO@BAR.COM>" can be replaced by "John Smith <foo@bar.com>".
1636 (cond ((and (= 1 (length mails)) (string= (bbdb-dwim-mail record (car mails))
1637 (buffer-substring-no-properties beg end)))
1638 (setq done 'UNCHANGED))
1639 (cycle-completion-buffer ; Use completion buffer.
1640 (setq dwim-completions (mapcar (lambda (n) (bbdb-dwim-mail record n)) mails)
1641 done 'CHOOSE))
1642 (t ; Use next mail
1643 (let ((mail (or (nth 1 (or (icicle-member-ignore-case (nth 1 address) mails)
1644 (icicle-member-ignore-case orig mails)))
1645 (nth 0 mails))))
1646 (delete-region beg end) ; Replace with new mail address
1647 (insert (bbdb-dwim-mail record mail))
1648 (setq done 'CYCLE)))))))
1649 (when (eq done 'CHOOSE)
1650 ;; Icicles completion. `completion-in-region' does not work here, as `dwim-completions' is not a
1651 ;; collection for completion in the usual sense. It is really a list of replacements.
1652 (unless (eq (selected-window) (minibuffer-window)) (message "Making completion list..."))
1653 (icicle-condition-case-no-debug nil
1654 (let* ((icicle-show-Completions-initially-flag t)
1655 (icicle-incremental-completion-p 'display)
1656 (icicle-top-level-when-sole-completion-flag t)
1657 (completion-ignore-case t)
1658 (choice
1659 (save-excursion (completing-read "Complete: " (mapcar #'list dwim-completions)
1660 nil t pattern nil pattern))))
1661 (when choice
1662 (delete-region beg end)
1663 (insert choice)))
1664 (error nil))
1665 (unless (eq (selected-window) (minibuffer-window)) (message "Making completion list...done")))
1666 done))
1667
1668
1669 ;; REPLACE ORIGINAL `bbdb-complete-name' defined in `bbdb-com.el' version 2.35,
1670 ;; saving it for restoration when you toggle `icicle-mode'.
1671 ;;
1672 ;; Version 2.35 is an older version of BBDB, the Insidious Big Brother Database, available here:
1673 ;; http://bbdb.sourceforge.net/.
1674 ;;
1675 ;; Uses Icicles completion when there are multiple candidates.
1676 ;;
1677 ;; Free vars here: `bbdb-*' are bound in `bbdb-com.el'.
1678 ;;
1679 ;;
1680 ;; Avoid a byte-compile error if user has already loaded BBDB version 3+.
1681 ;; The error has to do with `bbdb-records' being a defsubst that takes no args.
1682 (unless (eval-when-compile (and (featurep 'bbdb) (or (not (zerop (string-to-number bbdb-version)))
1683 (not (string-lessp bbdb-version "3")))))
1684 (defun icicle-bbdb-complete-name (&optional start-pos)
1685 "Complete the user full-name or net-address before point.
1686 Completes only up to the preceding newline, colon, or comma, or the
1687 value of START-POS.
1688
1689 If what has been typed is unique, insert an entry of the form \"User
1690 Name <net-addr>\" (but see `bbdb-dwim-net-address-allow-redundancy').
1691 If it is a valid completion but not unique, you can choose from the
1692 list of completions using Icicles completion.
1693
1694 If your input is completed and `bbdb-complete-name-allow-cycling' is
1695 true, then you can repeat to cycle through the nets for the matching
1696 record.
1697
1698 When called with a prefix arg, display a list of all nets. You can
1699 control completion behaviour using `bbdb-completion-type'."
1700 (interactive)
1701 (unless (and (require 'bbdb nil t) (require 'bbdb-com nil t)
1702 (fboundp 'bbdb-complete-name))
1703 (icicle-user-error "`icicle-bbdb-complete-name' requires a BBDB version such as 2.35"))
1704 (lexical-let* ((end (point))
1705 (beg (or start-pos (save-excursion (re-search-backward
1706 "\\(\\`\\|[\n:,]\\)[ \t]*")
1707 (goto-char (match-end 0)) (point))))
1708 (orig (buffer-substring beg end))
1709 (typed (downcase orig))
1710 (pattern (bbdb-string-trim typed))
1711 ;; DADAMS -
1712 ;; Replaced `(bbdb-hashtable)' by its expansion (bbdb-with-db-buffer ... bbdb-hashtable),
1713 ;; to avoid the silly macro altogether and simplify user byte-compiling a little.
1714 (ht (bbdb-with-db-buffer (bbdb-records nil t) bbdb-hashtable))
1715 ;; Make a list of possible completion strings (all-the-completions), and a flag to
1716 ;; indicate if there's a single matching record or not (only-one-p).
1717 (only-one-p t)
1718 (all-the-completions ())
1719 (pred
1720 (lambda (sym) ; FREE here: ALL-THE-COMPLETIONS, ONLY-ONE-P.
1721 (and (bbdb-completion-predicate sym)
1722 (progn
1723 (when (and only-one-p
1724 all-the-completions
1725 (or
1726 ;; Not sure about this. More than one record attached to the symbol?
1727 ;; Does that happen?
1728 (> (length (symbol-value sym)) 1)
1729 ;; This is the doozy. Multiple syms which all match the same record.
1730 (delete t (mapcar (lambda (x) ; FREE here: SYM.
1731 (equal (symbol-value x) (symbol-value sym)))
1732 all-the-completions))))
1733 (setq only-one-p nil))
1734 (and (not (memq sym all-the-completions))
1735 (setq all-the-completions (cons sym all-the-completions)))))))
1736 (completion (progn (all-completions pattern ht pred)
1737 (try-completion pattern ht)))
1738 (exact-match (eq completion t)))
1739 (cond
1740 ;; No matches found OR you're trying completion on an already-completed record.
1741 ;; In the latter case, we might have to cycle through the nets for that record.
1742 ((or (null completion)
1743 (and bbdb-complete-name-allow-cycling
1744 exact-match ; Which is a net of the record
1745 (member orig (bbdb-record-net (car (symbol-value (intern-soft pattern ht)))))))
1746 (bbdb-complete-name-cleanup) ; Clean up the completion buffer, if it exists
1747 (unless (catch 'bbdb-cycling-exit ; Check for cycling
1748 ;; Jump straight out if we're not cycling
1749 (unless bbdb-complete-name-allow-cycling (throw 'bbdb-cycling-exit nil))
1750 ;; Find the record we're working on.
1751 (lexical-let* ((addr (funcall bbdb-extract-address-components-func orig))
1752 (rec (and (listp addr)
1753 ;; For now, we ignore the case where this returns more than
1754 ;; one record. Ideally, the last expansion would be stored
1755 ;; in a buffer-local variable, perhaps.
1756 (car (bbdb-search-intertwingle (caar addr)
1757 (car (cdar addr)))))))
1758 (unless rec (throw 'bbdb-cycling-exit nil))
1759 (if current-prefix-arg
1760 ;; Use completion buffer
1761 (let ((standard-output (get-buffer-create "*Completions*")))
1762 ;; A previously existing buffer has to be cleaned first
1763 (with-current-buffer standard-output
1764 (setq buffer-read-only nil)
1765 (erase-buffer))
1766 (display-completion-list
1767 (mapcar (lambda (n) (bbdb-dwim-net-address rec n)) ; FREE here: REC.
1768 (bbdb-record-net rec)))
1769 (delete-region beg end)
1770 (switch-to-buffer standard-output))
1771 ;; Use next address
1772 (let* ((addrs (bbdb-record-net rec))
1773 (this-addr (or (cadr (member (car (cdar addr)) addrs)) (nth 0 addrs))))
1774 (if (= (length addrs) 1)
1775 (throw 'bbdb-cycling-exit t) ; No alternatives. don't signal an error.
1776 ;; Replace with new mail address
1777 (delete-region beg end)
1778 (insert (bbdb-dwim-net-address rec this-addr))
1779 (run-hooks 'bbdb-complete-name-hooks)
1780 (throw 'bbdb-cycling-exit t))))))
1781 ;; FALL THROUGH. Check mail aliases
1782 (when (and (or (not bbdb-expand-mail-aliases) (not (expand-abbrev))) bbdb-complete-name-hooks)
1783 (message "No completion for `%s'" pattern) (icicle-ding)))) ; no matches
1784
1785 ;; Match for a single record. If cycling is enabled then we don't
1786 ;; care too much about the exact-match part.
1787 ((and only-one-p (or exact-match bbdb-complete-name-allow-cycling))
1788 (let* ((sym (if exact-match (intern-soft pattern ht) (car all-the-completions)))
1789 (recs (symbol-value sym))
1790 the-net match-recs lst primary matched)
1791 (while recs
1792 (when (bbdb-record-net (car recs))
1793 ;; Did we match on name?
1794 (let ((b-r-name (or (bbdb-record-name (car recs)) "")))
1795 (when (string= pattern (substring (downcase b-r-name) 0
1796 (min (length b-r-name) (length pattern))))
1797 (setq match-recs (cons (car recs) match-recs)
1798 matched t)))
1799 ;; Did we match on aka?
1800 (unless matched
1801 (setq lst (bbdb-record-aka (car recs)))
1802 (while lst
1803 (if (string= pattern (substring (downcase (car lst)) 0
1804 (min (length (downcase (car lst)))
1805 (length pattern))))
1806 (setq match-recs (append match-recs (list (car recs)))
1807 matched t
1808 lst ())
1809 (setq lst (cdr lst)))))
1810 ;; Name didn't match name so check net matching
1811 (unless matched
1812 (setq lst (bbdb-record-net (car recs))
1813 primary t) ; primary wins over secondary...
1814 (while lst
1815 (when (string= pattern (substring (downcase (car lst)) 0
1816 (min (length (downcase (car lst)))
1817 (length pattern))))
1818 (setq the-net (car lst)
1819 lst ()
1820 match-recs (if primary
1821 (cons (car recs) match-recs)
1822 (append match-recs (list (car recs))))))
1823 (setq lst (cdr lst)
1824 primary nil))))
1825 (setq recs (cdr recs) ; Next rec for loop.
1826 matched nil))
1827 (unless match-recs (error "Only exact matching record has net field"))
1828 ;; Replace the text with the expansion
1829 (delete-region beg end)
1830 (insert (bbdb-dwim-net-address (car match-recs) the-net))
1831 ;; If we're past fill-column, wrap at the previous comma.
1832 (when (and (bbdb-auto-fill-function) (>= (current-column) fill-column))
1833 (let ((p (point))
1834 bol)
1835 (save-excursion
1836 (setq bol (line-beginning-position))
1837 (goto-char p)
1838 (when (search-backward "," bol t) (forward-char 1) (insert "\n ")))))
1839 ;; Update the *BBDB* buffer if desired.
1840 (when bbdb-completion-display-record
1841 (let ((bbdb-gag-messages t))
1842 (bbdb-pop-up-bbdb-buffer)
1843 (bbdb-display-records-1 match-recs t)))
1844 (bbdb-complete-name-cleanup)
1845 ;; Call the exact-completion hook
1846 (run-hooks 'bbdb-complete-name-hooks)))
1847
1848 ;; Partial match. Note: we can't use the trimmed version of the pattern here or
1849 ;; we'll recurse infinitely on e.g. common first names.
1850 ((and (stringp completion) (not (string= typed completion)))
1851 (delete-region beg end)
1852 (insert completion)
1853 (setq end (point))
1854 (let ((last "")
1855 (bbdb-complete-name-allow-cycling nil))
1856 (while (and (stringp completion) (not (string= completion last))
1857 (setq last completion
1858 pattern (downcase orig)
1859 completion (progn (all-completions pattern ht pred)
1860 (try-completion pattern ht))))
1861 (when (stringp completion) (delete-region beg end) (insert completion)))
1862 (bbdb-complete-name beg))) ; RECURSE <================
1863
1864 ;; Exact match, but more than one record
1865 (t
1866 (unless (eq (selected-window) (minibuffer-window)) (message "Making completion list..."))
1867 (lexical-let (dwim-completions uniq nets net name akas)
1868 ;; Collect all the dwim-addresses for each completion, but only once for each record.
1869 ;; Add if the net is part of the completions.
1870 (bbdb-mapc (lambda (sym)
1871 (bbdb-mapc
1872 ;; FREE here: AKAS, ALL-THE-COMPLETIONS, DWIM-COMPLETIONS, HT,
1873 ;; NAME, NET, NETS, SYM, UNIQ.
1874 (lambda (rec)
1875 (unless (member rec uniq)
1876 (setq uniq (cons rec uniq)
1877 nets (bbdb-record-net rec)
1878 name (downcase (or (bbdb-record-name rec) ""))
1879 akas (mapcar 'downcase (bbdb-record-aka rec)))
1880 (while nets
1881 (setq net (car nets))
1882 (when (cond
1883 ((and (member bbdb-completion-type ; Primary
1884 '(primary primary-or-name))
1885 (member (intern-soft (downcase net) ht)
1886 all-the-completions))
1887 (setq nets ())
1888 t)
1889 ((and name (member bbdb-completion-type ; Name
1890 '(nil name primary-or-name))
1891 (let ((cname (symbol-name sym)))
1892 (or (string= cname name) (member cname akas))))
1893 (setq name nil)
1894 t)
1895 ((and (member bbdb-completion-type '(nil net)) ; Net
1896 (member (intern-soft (downcase net) ht) all-the-completions)))
1897 ;; (name-or-)primary
1898 ((and (member bbdb-completion-type '(name-or-primary))
1899 (let ((cname (symbol-name sym)))
1900 (or (string= cname name) (member cname akas))))
1901 (setq nets ())
1902 t))
1903 (setq dwim-completions
1904 (cons (bbdb-dwim-net-address rec net)
1905 dwim-completions))
1906 (when exact-match (setq nets ())))
1907 (setq nets (cdr nets)))))
1908 (symbol-value sym)))
1909 all-the-completions)
1910 (cond ((and dwim-completions (null (cdr dwim-completions))) ; Insert the unique match.
1911 (delete-region beg end) (insert (car dwim-completions)) (message ""))
1912 (t ; More than one match. Use Icicles minibuffer completion.
1913 (icicle-condition-case-no-debug nil
1914 (let* ((icicle-show-Completions-initially-flag t)
1915 (icicle-incremental-completion-p 'display)
1916 (icicle-top-level-when-sole-completion-flag t)
1917 (completion-ignore-case t)
1918 (choice
1919 (save-excursion
1920 (completing-read "Complete: " (mapcar #'list dwim-completions)
1921 nil t pattern nil pattern))))
1922 (when choice
1923 (delete-region beg end)
1924 (insert choice)))
1925 (error nil))
1926 (unless (eq (selected-window) (minibuffer-window))
1927 (message "Making completion list...done"))))))))))
1928
1929
1930 ;; REPLACE ORIGINAL `lisp-complete-symbol' (< Emacs 23.2),
1931 ;; defined in `lisp.el', saving it for restoration when you toggle `icicle-mode'.
1932 ;;
1933 ;; Select `*Completions*' window even if on another frame.
1934 ;;
1935 (unless (fboundp 'icicle-ORIG-lisp-complete-symbol)
1936 (defalias 'icicle-ORIG-lisp-complete-symbol (symbol-function 'lisp-complete-symbol)))
1937
1938 (defun icicle-lisp-complete-symbol (&optional predicate) ; `M-TAB' (`C-M-i', `ESC-TAB'), globally.
1939 "Complete the Lisp symbol preceding point against known Lisp symbols.
1940 If there is more than one completion, use the minibuffer to complete.
1941
1942 When called from a program, optional arg PREDICATE is a predicate
1943 determining which symbols are considered, e.g. `commandp'.
1944
1945 If PREDICATE is nil, the context determines which symbols are
1946 considered. If the symbol starts just after an open-parenthesis, only
1947 symbols with function definitions are considered. Otherwise, all
1948 symbols with function definitions, values or properties are
1949 considered."
1950 (interactive)
1951 (let* ((pos (point))
1952 (buffer-syntax (syntax-table))
1953 ;; $$$$$$ FIXME: In minibuffer with no input, `backward-sexp' moves into the prompt, which is
1954 ;; read-only. What we do currently is just let that happen and let the pattern be "".
1955 ;; Better would be to stop movement into the prompt etc. See also Emacs bug #16453.
1956 (beg (unwind-protect
1957 (progn
1958 (set-syntax-table emacs-lisp-mode-syntax-table)
1959 (condition-case nil
1960 (save-excursion
1961 (backward-sexp 1)
1962 (skip-syntax-forward "'")
1963 (point))
1964 (scan-error pos)))
1965 (set-syntax-table buffer-syntax)))
1966 (end (unless (or (eq beg (point-max))
1967 (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
1968 (unwind-protect
1969 (progn
1970 (set-syntax-table emacs-lisp-mode-syntax-table)
1971 (condition-case nil
1972 (save-excursion
1973 (goto-char beg)
1974 (forward-sexp 1)
1975 (max (point) beg))
1976 (scan-error pos)))
1977 (set-syntax-table buffer-syntax))))
1978 (pattern (buffer-substring beg (or end beg)))
1979 (new (try-completion pattern obarray)))
1980 (unless (stringp new) (setq new pattern))
1981 (condition-case nil (delete-region beg end) (error nil)) ; E.g. read-only text of a prompt.
1982 (goto-char beg)
1983 (insert new)
1984 (setq end (+ beg (length new)))
1985 (if (and (not (string= new "")) (not (string= (downcase new) (downcase pattern)))
1986 (< (length (all-completions new obarray)) 2))
1987 (message "Completed (no other completions)")
1988 ;; Use minibuffer to choose a completion.
1989 (let* ((enable-recursive-minibuffers (active-minibuffer-window))
1990 (icicle-top-level-when-sole-completion-flag t)
1991 (icicle-orig-window (selected-window)) ; For alt actions.
1992 (alt-fn nil)
1993 (icicle-show-Completions-initially-flag t)
1994 (icicle-candidate-alt-action-fn
1995 (or icicle-candidate-alt-action-fn (setq alt-fn (icicle-alt-act-fn-for-type "symbol"))))
1996 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1997 (or icicle-all-candidates-list-alt-action-fn
1998 alt-fn
1999 (icicle-alt-act-fn-for-type "symbol")))
2000 (predicate
2001 (or predicate
2002 (save-excursion
2003 (goto-char beg)
2004 (if (not (eq (char-before) ?\( ))
2005 (lambda (sym) ;why not just nil ? -sm
2006 (or (boundp sym) (fboundp sym) (symbol-plist sym)))
2007 ;; If first element of parent list is not an open paren, assume that this is a
2008 ;; funcall position: use `fboundp'. If not, then maybe this is a variable in
2009 ;; a `let' binding, so no predicate: use nil.
2010 (and (not (condition-case nil
2011 (progn (up-list -2) (forward-char 1) (eq (char-after) ?\( ))
2012 (error nil)))
2013 'fboundp))))))
2014 ;; $$$$$ Could bind `icicle-must-pass-after-match-predicate' to a predicate on interned
2015 ;; candidate and pass nil as PRED to `completing-read'. Don't bother for now.
2016 (setq new (save-excursion (completing-read "Complete Lisp symbol: "
2017 obarray predicate t new)))))
2018 (condition-case nil (delete-region beg end) (error nil)) ; E.g. read-only text of a prompt.
2019 (insert new)))
2020
2021
2022 ;; REPLACE ORIGINAL `lisp-completion-at-point' (>= Emacs 23.2),
2023 ;; defined in `lisp.el', saving it for restoration when you toggle `icicle-mode'.
2024 ;;
2025 ;; Select `*Completions*' window even if on another frame.
2026 ;;
2027 (when (fboundp 'completion-at-point) ; Emacs 23.2+.
2028 (unless (fboundp 'icicle-ORIG-lisp-completion-at-point)
2029 (defalias 'icicle-ORIG-lisp-completion-at-point (symbol-function 'lisp-completion-at-point))
2030 ;; Return a function that does all of the completion.
2031 (defun icicle-lisp-completion-at-point () #'icicle-lisp-complete-symbol)))
2032
2033 (defun icicle-customize-icicles-group ()
2034 "Customize Icicles options and faces. View their documentation."
2035 (interactive)
2036 (customize-group-other-window 'Icicles))
2037
2038 (defun icicle-send-bug-report ()
2039 "Send a bug report about an Icicles problem."
2040 (interactive)
2041 (browse-url (format (concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
2042 Icicles bug: \
2043 &body=Describe bug below, using a precise recipe that starts with `emacs -Q' or `emacs -q'. \
2044 Each Icicles file has a header `Update #' that you can use to identify it. \
2045 Include at least the `Update #' from file `icicles-chg.el', if you have that file.\
2046 %%0A%%0AEmacs version: %s.")
2047 (emacs-version))))
2048
2049
2050 ;; REPLACE ORIGINAL `customize-face-other-window' defined in `cus-edit.el',
2051 ;; saving it for restoration when you toggle `icicle-mode'.
2052 ;;
2053 ;; Multi-command version.
2054 ;;
2055 (unless (fboundp 'icicle-ORIG-customize-face-other-window)
2056 (defalias 'icicle-ORIG-customize-face-other-window (symbol-function 'customize-face-other-window)))
2057
2058 (defun icicle-customize-face-other-window (face)
2059 "Customize face FACE in another window.
2060 Same as `icicle-customize-face' except it uses a different window."
2061 (interactive
2062 (list (let* ((icicle-multi-completing-p t)
2063 (icicle-list-use-nth-parts '(1))
2064 (icicle-candidate-action-fn
2065 (lambda (fc)
2066 (let ((proxy (car (member fc icicle-proxy-candidates))))
2067 (setq fc (icicle-transform-multi-completion fc)
2068 fc (if proxy
2069 (symbol-value (intern (substring proxy 1 (1- (length proxy)))))
2070 (intern fc)))
2071 (icicle-ORIG-customize-face fc))
2072 (select-window (minibuffer-window))
2073 (select-frame-set-input-focus (selected-frame))))
2074 (icicle-all-candidates-list-action-fn 'icicle-customize-faces)
2075 (icicle-orig-window (selected-window)) ; For alt actions.
2076 (alt-fn nil)
2077 (icicle-candidate-alt-action-fn
2078 (or icicle-candidate-alt-action-fn
2079 (setq alt-fn (icicle-alt-act-fn-for-type "face"))))
2080 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2081 (or icicle-all-candidates-list-alt-action-fn
2082 alt-fn
2083 (icicle-alt-act-fn-for-type "face"))))
2084 (if (and (> emacs-major-version 21) current-prefix-arg)
2085 (read-face-name "Customize face: " "all faces" t)
2086 (read-face-name "Customize face: ")))))
2087 (icicle-ORIG-customize-face-other-window face))
2088
2089
2090 ;; REPLACE ORIGINAL `customize-face' defined in `cus-edit.el',
2091 ;; saving it for restoration when you toggle `icicle-mode'.
2092 ;;
2093 ;; Multi-command version.
2094 ;;
2095 (unless (fboundp 'icicle-ORIG-customize-face)
2096 (defalias 'icicle-ORIG-customize-face (symbol-function 'customize-face)))
2097
2098 (defun icicle-customize-face (face &optional other-window)
2099 "Customize face FACE. If OTHER-WINDOW is non-nil, use another window.
2100 Input-candidate completion and cycling are available. While cycling,
2101 these keys with prefix `C-' are active\\<minibuffer-local-completion-map>:
2102
2103 `C-mouse-2', `C-RET' - Act on current completion candidate only
2104 `C-down' - Move to next completion candidate and act
2105 `C-up' - Move to previous completion candidate and act
2106 `C-next' - Move to next apropos-completion candidate and act
2107 `C-prior' - Move to previous apropos-completion candidate and act
2108 `C-end' - Move to next prefix-completion candidate and act
2109 `C-home' - Move to previous prefix-completion candidate and act
2110 `\\[icicle-all-candidates-list-action]' - Act on *all* candidates (or all that are saved):
2111 Customize all in the same buffer.
2112 `\\[icicle-all-candidates-action]' - Act on *all* candidates (or all that are saved):
2113 Customize each in a separate buffer.
2114
2115 When candidate action and cycling are combined (e.g. `C-next'), option
2116 `icicle-act-before-cycle-flag' determines which occurs first.
2117
2118 With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2',
2119 `C-M-return', `C-M-down', and so on) provide help about candidates.
2120
2121 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate,
2122 or `C-g' to quit.
2123
2124 With no prefix argument:
2125
2126 * Candidates are shown according to option
2127 `icicle-WYSIWYG-Completions-flag'.
2128
2129 * If `icicle-add-proxy-candidates-flag' is non-nil then proxy
2130 candidates are included. These are the names of face-name options,
2131 that is, options with custom-type `face'. The face that is option
2132 value is used.
2133
2134 With a prefix argument:
2135
2136 * You get no WYSIWYG display and no proxy candidates.
2137
2138 * You can enter multiple faces at the same time with a single
2139 `RET' (in Emacs 22 or later). This gives you more or less the `crm'
2140 completion behavior of `customize-face' in vanilla Emacs. Most
2141 Icicles completion features are still available, but `TAB' performs
2142 `crm' completion, so it does not also cycle among completion
2143 candidates. You can, as always, use `down' to do that.
2144
2145 This is an Icicles command - see command `icicle-mode'."
2146 (interactive
2147 (list (let* ((icicle-multi-completing-p t)
2148 (icicle-list-use-nth-parts '(1))
2149 (icicle-candidate-action-fn
2150 (lambda (fc)
2151 (let ((proxy (car (member fc icicle-proxy-candidates))))
2152 (setq fc (icicle-transform-multi-completion fc)
2153 fc (if proxy
2154 (symbol-value (intern (substring proxy 1 (1- (length proxy)))))
2155 (intern fc)))
2156 (icicle-ORIG-customize-face fc))
2157 (select-window (minibuffer-window))
2158 (select-frame-set-input-focus (selected-frame))))
2159 (icicle-all-candidates-list-action-fn 'icicle-customize-faces)
2160 (icicle-orig-window (selected-window)) ; For alt actions.
2161 (alt-fn nil)
2162 (icicle-candidate-alt-action-fn
2163 (or icicle-candidate-alt-action-fn (setq alt-fn (icicle-alt-act-fn-for-type "face"))))
2164 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2165 (or icicle-all-candidates-list-alt-action-fn
2166 alt-fn
2167 (icicle-alt-act-fn-for-type "face"))))
2168 (if (and (> emacs-major-version 21) current-prefix-arg)
2169 (read-face-name "Customize face: " "all faces" t)
2170 (read-face-name "Customize face: ")))))
2171 (if other-window
2172 (if (> emacs-major-version 23)
2173 (icicle-ORIG-customize-face face t)
2174 (icicle-ORIG-customize-face-other-window face))
2175 (icicle-ORIG-customize-face face)))
2176
2177 (defun icicle-customize-faces (faces)
2178 "Open Customize buffer on all faces in list FACES."
2179 (let ((icicle-list-nth-parts-join-string ": ")
2180 (icicle-list-join-string ": ")
2181 (icicle-list-use-nth-parts '(1)))
2182 (custom-buffer-create
2183 (custom-sort-items
2184 (mapcar (lambda (f) (list (intern (icicle-transform-multi-completion f)) 'custom-face)) faces)
2185 t custom-buffer-order-groups)
2186 "*Customize Apropos*")))
2187
2188 ;; Icicles replacement for `customize-apropos', defined in `cus-edit.el'.
2189 ;; 1. Uses `completing-read' to read the regexp.
2190 ;; 2. Fixes Emacs bugs #11132, #11126.
2191 ;;
2192 (defun icicle-customize-apropos (pattern &optional type msgp)
2193 "Customize all loaded user preferences matching PATTERN.
2194 When prompted for the PATTERN, you can use completion against
2195 preference names - e.g. `S-TAB'. Instead of entering a pattern you
2196 can then just hit `RET' to accept the list of matching preferences.
2197 This lets you see which preferences will be available in the customize
2198 buffer and dynamically change that list.
2199
2200 Interactively:
2201
2202 With no prefix arg, customize all matching preferences: groups, faces,
2203 and options. With a prefix arg, show those plus all matching
2204 non-option variables in Customize (but you cannot actually customize
2205 the latter).
2206
2207 Non-interactively:
2208
2209 If TYPE is `options', include only user options.
2210 If TYPE is `faces', include only faces.
2211 If TYPE is `groups', include only groups.
2212 If TYPE is t, include variables that are not user options, as well as
2213 faces and groups.
2214
2215 PATTERN is a regexp.
2216
2217 Starting with Emacs 22, if PATTERN includes no regexp special chars
2218 then it can alternatively be a list of \"words\" separated by spaces.
2219 Two or more of the words are matched in different orders against each
2220 preference name. \"Word\" here really means a string of non-space
2221 chars.
2222
2223 This handling of \"words\" is for compatibility with vanilla Emacs,
2224 and is only approximative. It can include \"matches\" that you do not
2225 expect. For better matching use Icicles progressive completion, i.e.,
2226 separate the words (any strings, in fact, including regexps) using
2227 `S-SPC', not just `SPC'."
2228 (interactive
2229 (let* ((pref-arg current-prefix-arg)
2230 (pred `(lambda (s)
2231 (unless (symbolp s) (setq s (intern s)))
2232 (or (get s 'custom-group)
2233 (custom-facep s)
2234 (and (boundp s)
2235 (or (get s 'saved-value)
2236 (custom-variable-p s)
2237 (if (null ',pref-arg)
2238 (user-variable-p s)
2239 (get s 'variable-documentation)))))))
2240 (icompletep (and (featurep 'icomplete) icomplete-mode))
2241 (icicle-must-pass-after-match-predicate (and (not icompletep) pred)))
2242 (list (completing-read "Customize (pattern): " obarray (and icompletep pred) nil nil 'regexp-history)
2243 pref-arg
2244 t)))
2245 (let ((found ()))
2246 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2247 (string= (regexp-quote pattern) pattern)
2248 (not (string= "" pattern)))
2249 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2250 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2251 (when msgp (message "Gathering apropos data for customize `%s'..." pattern))
2252 (mapatoms `(lambda (symbol) ; FREE here: APROPOS-REGEXP.
2253 (when (string-match ,(and (> emacs-major-version 21) apropos-regexp pattern)
2254 (symbol-name symbol))
2255 (when (and (not (memq ,type '(faces options))) ; groups or t
2256 (get symbol 'custom-group))
2257 (push (list symbol 'custom-group) found))
2258 (when (and (not (memq ,type '(options groups))) ; faces or t
2259 (custom-facep symbol))
2260 (push (list symbol 'custom-face) found))
2261 (when (and (not (memq ,type '(groups faces))) ; options or t
2262 (boundp symbol)
2263 (or (get symbol 'saved-value)
2264 (custom-variable-p symbol)
2265 (if (memq ,type '(nil options))
2266 (user-variable-p symbol)
2267 (get symbol 'variable-documentation))))
2268 (push (list symbol 'custom-variable) found)))))
2269 (unless found
2270 (error "No %s matching %s" (if (eq type t)
2271 "items"
2272 (format "%s" (if (memq type '(options faces groups))
2273 (symbol-name type)
2274 "customizable items")))
2275 pattern))
2276 (custom-buffer-create (custom-sort-items found t custom-buffer-order-groups) "*Customize Apropos*")))
2277
2278 ;; Define this for Emacs 20 and 21
2279 (unless (fboundp 'custom-variable-p)
2280 (defun custom-variable-p (variable)
2281 "Return non-nil if VARIABLE is a custom variable."
2282 (and (symbolp variable)
2283 (or (get variable 'standard-value) (get variable 'custom-autoload)))))
2284
2285 ;; Icicles replacement for `customize-apropos-faces', defined in `cus-edit.el'.
2286 ;; 1. Uses `completing-read' to read the regexp.
2287 ;; 2. Fixes Emacs bug #11124.
2288 ;;
2289 (defun icicle-customize-apropos-faces (pattern &optional msgp)
2290 "Customize all loaded faces matching PATTERN.
2291 See `icicle-customize-apropos'."
2292 (interactive
2293 (let* ((pred (lambda (s)
2294 (unless (symbolp s) (setq s (intern s)))
2295 (custom-facep s)))
2296 (icompletep (and (featurep 'icomplete) icomplete-mode))
2297 (icicle-must-pass-after-match-predicate (and (not icompletep) pred)))
2298 (list (completing-read "Customize faces (pattern): " obarray (and icompletep pred)
2299 nil nil 'regexp-history)
2300 t)))
2301 (when msgp (message "Gathering apropos data for customizing faces..."))
2302 (customize-apropos pattern 'faces))
2303
2304 ;; Icicles replacement for `customize-apropos-groups', defined in `cus-edit.el'.
2305 ;; 1. Uses `completing-read' to read the regexp.
2306 ;; 2. Fixes Emacs bug #11124.
2307 ;;
2308 (defun icicle-customize-apropos-groups (pattern &optional msgp)
2309 "Customize all loaded customize groups matching PATTERN.
2310 See `icicle-customize-apropos'."
2311 (interactive
2312 (let* ((pred (lambda (s)
2313 (unless (symbolp s) (setq s (intern s)))
2314 (get s 'custom-group)))
2315 (icompletep (and (featurep 'icomplete) icomplete-mode))
2316 (icicle-must-pass-after-match-predicate (and (not icompletep) pred)))
2317 (list (completing-read "Customize groups (pattern): " obarray (and icompletep pred)
2318 nil nil 'regexp-history)
2319 t)))
2320 (when msgp (message "Gathering apropos data for customizing groups..."))
2321 (customize-apropos pattern 'groups))
2322
2323 ;; Icicles replacement for `customize-apropos-options', defined in `cus-edit.el'.
2324 ;; 1. Uses `completing-read' to read the regexp.
2325 ;; 2. Fixes Emacs bugs #11124, #11128.
2326 ;;
2327 (defun icicle-customize-apropos-options (pattern &optional arg msgp)
2328 "Customize all loaded user options matching PATTERN.
2329 See `icicle-customize-apropos'.
2330
2331 With a prefix arg, include variables that are not user options as
2332 completion candidates, and include also matching faces and groups in
2333 the customize buffer."
2334 (interactive
2335 (let* ((pref-arg current-prefix-arg)
2336 (pred `(lambda (s)
2337 (unless (symbolp s) (setq s (intern s)))
2338 (and (boundp s)
2339 (or (get s 'saved-value)
2340 (custom-variable-p s)
2341 (user-variable-p s)
2342 (and ',pref-arg
2343 (get s 'variable-documentation))))))
2344 (icompletep (and (featurep 'icomplete) icomplete-mode))
2345 (icicle-must-pass-after-match-predicate (and (not icompletep) pred)))
2346 (list (completing-read "Customize options (pattern): " obarray (and icompletep pred)
2347 nil nil 'regexp-history)
2348 pref-arg
2349 t)))
2350 (when msgp (message "Gathering apropos data for customizing options..."))
2351 (customize-apropos pattern (or arg 'options)))
2352
2353 (icicle-define-command icicle-customize-apropos-options-of-type
2354 "Customize all loaded user options of a given type.
2355 Enter patterns for the OPTION name and TYPE definition in the
2356 minibuffer, separated by `icicle-list-join-string', which is \"^G^J\",
2357 by default. (`^G' here means the Control-g character, input using
2358 `C-h C-g'. Likewise, for `^J'.)
2359
2360 OPTION is a regexp that is matched against option names.
2361
2362 See `icicle-describe-option-of-type', which handles input and
2363 completion similarly, for a full description of TYPE, matching, and
2364 the use of a prefix argument." ; Doc string
2365 icicle-customize-apropos-opt-action ; Action function
2366 prompt ; `completing-read' args
2367 'icicle-describe-opt-of-type-complete nil nil nil nil nil nil
2368 ((prompt "OPTION `C-M-j' TYPE: ") ; Bindings
2369 (icicle-multi-completing-p t)
2370 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
2371 ;; Bind `icicle-apropos-complete-match-fn' to nil to prevent automatic input matching
2372 ;; in `icicle-unsorted-apropos-candidates' etc., because `icicle-describe-opt-of-type-complete'
2373 ;; does everything.
2374 (icicle-apropos-complete-match-fn nil)
2375 (icicle-last-apropos-complete-match-fn 'icicle-multi-comp-apropos-complete-match)
2376 (icicle-candidate-help-fn 'icicle-describe-opt-action)
2377 (icicle-pref-arg current-prefix-arg))
2378 (progn (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code
2379 (icicle-highlight-lighter)
2380 (message "Gathering user options and their types...")))
2381
2382 (defun icicle-customize-apropos-opt-action (opt+type)
2383 "Action function for `icicle-customize-apropos-options-of-type'."
2384 (let ((icicle-list-use-nth-parts '(1)))
2385 (custom-buffer-create (custom-sort-items (mapcar (lambda (s) (list (intern s) 'custom-variable))
2386 icicle-completion-candidates)
2387 t "*Customize Apropos*"))))
2388
2389 (defun icicle-apropos (pattern &optional do-all msgp)
2390 "Describe Lisp symbols whose names match PATTERN.
2391 By default, show symbols only if they are defined as functions,
2392 variables, or faces, or if they have nonempty property lists.
2393
2394 With a prefix argument, or if `apropos-do-all' is non-nil, describe all
2395 matching symbols.
2396
2397 Return a list of the symbols and descriptions.
2398
2399 Like command `apropos', but you can preview the list of matches using
2400 `S-TAB'. Function names are highlighted using face
2401 `icicle-special-candidate'.
2402
2403 When prompted for the PATTERN, you can use completion against
2404 preference names - e.g. `S-TAB'. Instead of entering a pattern you
2405 can then just hit `RET' to accept the list of matching preferences.
2406 This lets you see which preferences will be available in the customize
2407 buffer and dynamically change that list.
2408
2409 PATTERN is a regexp.
2410
2411 Starting with Emacs 22, if PATTERN includes no regexp special chars
2412 then it can alternatively be a list of \"words\" separated by spaces.
2413 Two or more of the words are matched in different orders against each
2414 preference name. \"Word\" here really means a string of non-space
2415 chars.
2416
2417 This handling of \"words\" is for compatibility with vanilla Emacs,
2418 and is only approximative. It can include \"matches\" that you do not
2419 expect. For better matching use Icicles progressive completion, i.e.,
2420 separate the words (any strings, in fact, including regexps) using
2421 `S-SPC', not just `SPC'."
2422 (interactive
2423 (list
2424 (unwind-protect
2425 (progn
2426 (mapatoms (lambda (symb) (when (fboundp symb) (put symb 'icicle-special-candidate t))))
2427 (let ((icicle-fancy-candidates-p t)
2428 (icicle-candidate-alt-action-fn
2429 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "symbol")))
2430 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2431 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "symbol"))))
2432 (completing-read "Apropos symbol (regexp or words): " obarray
2433 nil nil nil 'regexp-history)))
2434 (mapatoms (lambda (symb) (put symb 'icicle-special-candidate nil))))
2435 current-prefix-arg
2436 t))
2437 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2438 (string= (regexp-quote pattern) pattern)
2439 (not (string= "" pattern)))
2440 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2441 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2442 (when msgp (message "Gathering apropos data..."))
2443 (apropos pattern do-all))
2444
2445 (cond
2446 ;; Use `apropos-variable' and `apropos-option' from `apropos-fn+var.el',
2447 ;; or use Emacs 24.4+ `apropos-variable' and `apropos-user-option'.
2448 ;; Note that `icicle-apropos-option' does not respect `apropos-do-all': it always works with only options.
2449 ((or (featurep 'apropos-fn+var) (fboundp 'apropos-user-option)) ; Emacs 24.4 defines `apropos-user-option'.
2450 (defun icicle-apropos-variable (pattern &optional msgp)
2451 "Show variables that match PATTERN.
2452 This includes variables that are not user options.
2453 User options are highlighted using face `icicle-special-candidate'.
2454 You can see the list of matches with `S-TAB'.
2455 See `icicle-apropos' for a description of PATTERN."
2456 (interactive
2457 (list
2458 (unwind-protect
2459 (progn
2460 (mapatoms (lambda (symb) (when (user-variable-p symb) (put symb 'icicle-special-candidate t))))
2461 (let* ((icicle-fancy-candidates-p t)
2462 (pred (lambda (s)
2463 (unless (symbolp s) (setq s (intern s)))
2464 (and (boundp s)
2465 (get s 'variable-documentation))))
2466 (icompletep (and (featurep 'icomplete) icomplete-mode))
2467 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))
2468 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn
2469 (icicle-alt-act-fn-for-type "variable")))
2470 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2471 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "variable"))))
2472 (completing-read
2473 (concat "Apropos variable (regexp" (and (>= emacs-major-version 22) " or words")
2474 "): ")
2475 obarray (and icompletep pred) nil nil 'regexp-history)))
2476 (mapatoms (lambda (symb) (put symb 'icicle-special-candidate nil))))
2477 t))
2478 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2479 (string= (regexp-quote pattern) pattern)
2480 (not (string= "" pattern)))
2481 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2482 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2483 (when msgp (message "Gathering data apropos variables..."))
2484 (apropos-variable pattern))
2485
2486 (defun icicle-apropos-option (pattern &optional msgp)
2487 "Show user options (variables) that match PATTERN.
2488 You can see the list of matches with `S-TAB'.
2489 See `icicle-apropos' for a description of PATTERN."
2490 (interactive
2491 (let* ((pred (lambda (s)
2492 (unless (symbolp s) (setq s (intern s)))
2493 (user-variable-p s)))
2494 (icompletep (and (featurep 'icomplete) icomplete-mode))
2495 (icicle-must-pass-after-match-predicate (and (not icompletep) pred)))
2496 (list (completing-read
2497 (concat "Apropos user option (regexp" (and (>= emacs-major-version 22) " or words")
2498 "): ") obarray (and icompletep pred) nil nil 'regexp-history)
2499 t)))
2500 (let ((apropos-do-all nil)
2501 (icicle-candidate-alt-action-fn
2502 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "option")))
2503 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2504 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "option"))))
2505 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2506 (string= (regexp-quote pattern) pattern)
2507 (not (string= "" pattern)))
2508 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2509 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2510 (when msgp (message "Gathering data apropos user options..."))
2511 (apropos-option pattern))))
2512
2513 ;; `apropos-fn+var.el' not available, and Emacs < 24.4. Use pre-24.4 vanilla Emacs versions.
2514 (t
2515 (defun icicle-apropos-variable (pattern &optional do-all msgp)
2516 "Show variables that match PATTERN.
2517 You can see the list of matches with `S-TAB'.
2518 See `icicle-apropos' for a description of PATTERN.
2519
2520 By default, only user options are candidates. With optional prefix
2521 DO-ALL, or if `apropos-do-all' is non-nil, all variables are
2522 candidates. In that case, the user-option candidates are highlighted
2523 using face `icicle-special-candidate'."
2524 (interactive
2525 (list
2526 (unwind-protect
2527 (progn
2528 (unless (or (boundp 'apropos-do-all) (require 'apropos nil t))
2529 (error "Library `apropos' not found"))
2530 (when (or current-prefix-arg apropos-do-all)
2531 (mapatoms (lambda (symb)
2532 (when (user-variable-p symb) (put symb 'icicle-special-candidate t)))))
2533 (let* ((icicle-fancy-candidates-p (or current-prefix-arg apropos-do-all))
2534 (pred (if (or current-prefix-arg apropos-do-all)
2535 (lambda (s)
2536 (unless (symbolp s)
2537 (setq s (intern s)))
2538 (and (boundp s)
2539 (get s 'variable-documentation)))
2540 (lambda (s)
2541 (unless (symbolp s) (setq s (intern s)))
2542 (user-variable-p s))))
2543 (icompletep (and (featurep 'icomplete) icomplete-mode))
2544 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))
2545 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn
2546 (icicle-alt-act-fn-for-type
2547 (if icicle-fancy-candidates-p
2548 "variable"
2549 "option"))))
2550 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2551 (or icicle-all-candidates-list-alt-action-fn
2552 (icicle-alt-act-fn-for-type (if icicle-fancy-candidates-p "variable" "option")))))
2553 (completing-read
2554 (concat "Apropos " (if (or current-prefix-arg apropos-do-all) "variable" "user option")
2555 " (regexp" (and (>= emacs-major-version 22) " or words") "): ")
2556 obarray (and icompletep pred) nil nil 'regexp-history)))
2557 (when (or current-prefix-arg apropos-do-all)
2558 (mapatoms (lambda (symb) (put symb 'icicle-special-candidate nil)))))
2559 current-prefix-arg
2560 t))
2561 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2562 (string= (regexp-quote pattern) pattern)
2563 (not (string= "" pattern)))
2564 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2565 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2566 (when msgp (message (format "Gathering data apropos %s..." (if do-all "variables" "options"))))
2567 (apropos-variable pattern do-all))))
2568
2569 (cond
2570 ;; Use `apropos-function' and `apropos-command' from `apropos-fn+var.el'.
2571 ;; Note that `icicle-apropos-command' does not respect `apropos-do-all': it always works with only commands.
2572 ((featurep 'apropos-fn+var)
2573 (defun icicle-apropos-function (pattern &optional msgp)
2574 "Show functions that match PATTERN.
2575 This includes functions that are not commands.
2576 Command names are highlighted using face `icicle-special-candidate'.
2577 You can see the list of matches with `S-TAB'.
2578 See `icicle-apropos' for a description of PATTERN."
2579 (interactive
2580 (list
2581 (unwind-protect
2582 (progn
2583 (mapatoms (lambda (symb) (when (commandp symb) (put symb 'icicle-special-candidate t))))
2584 (let* ((icicle-fancy-candidates-p t)
2585 (pred (lambda (s)
2586 (unless (symbolp s) (setq s (intern s)))
2587 (fboundp s)))
2588 (icompletep (and (featurep 'icomplete) icomplete-mode))
2589 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))
2590 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn
2591 (icicle-alt-act-fn-for-type "function")))
2592 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2593 (or icicle-all-candidates-list-alt-action-fn
2594 (icicle-alt-act-fn-for-type "function"))))
2595 (completing-read
2596 (concat "Apropos function (regexp" (and (>= emacs-major-version 22) " or words")
2597 "): ") obarray (and icompletep pred) nil nil 'regexp-history)))
2598 (mapatoms (lambda (symb) (put symb 'icicle-special-candidate nil))))
2599 t))
2600 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2601 (string= (regexp-quote pattern) pattern)
2602 (not (string= "" pattern)))
2603 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2604 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2605 (when msgp (message "Gathering data apropos functions..."))
2606 (apropos-function pattern))
2607
2608 (defun icicle-apropos-command (pattern &optional msgp)
2609 "Show commands (interactively callable functions) that match PATTERN.
2610 You can see the list of matches with `S-TAB'.
2611 See `icicle-apropos' for a description of PATTERN."
2612 (interactive
2613 (let* ((pred (lambda (s)
2614 (unless (symbolp s) (setq s (intern s)))
2615 (commandp s)))
2616 (icompletep (and (featurep 'icomplete) icomplete-mode))
2617 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))
2618 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn
2619 (icicle-alt-act-fn-for-type "command")))
2620 (icicle-all-candidates-list-alt-action-fn (or icicle-all-candidates-list-alt-action-fn ; `M-|'
2621 (icicle-alt-act-fn-for-type "command"))))
2622 (list (completing-read
2623 (concat "Apropos command (regexp" (and (>= emacs-major-version 22) " or words")
2624 "): ") obarray (and icompletep pred) nil nil 'regexp-history)
2625 t)))
2626 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2627 (string= (regexp-quote pattern) pattern)
2628 (not (string= "" pattern)))
2629 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2630 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2631 (when msgp (message "Gathering data apropos commands..."))
2632 (let ((apropos-do-all nil)) (apropos-command pattern))))
2633
2634 ;; `apropos-fn+var.el' not available. Use vanilla Emacs `apropos-command'.
2635 (t
2636 (defun icicle-apropos-command (pattern &optional do-all var-predicate msgp)
2637 "Show commands (interactively callable functions) that match PATTERN.
2638 You can see the list of matches with `S-TAB'.
2639
2640 See `icicle-apropos' for a description of PATTERN.
2641
2642 With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil,
2643 also show noninteractive functions. In that case, the command
2644 candidates are highlighted using face `icicle-special-candidate'.
2645
2646 If VAR-PREDICATE is non-nil, show only variables, and only those that
2647 satisfy the predicate VAR-PREDICATE.
2648
2649 Non-interactively, a string PATTERN is used as a regexp, while a list
2650 of strings is used as a word list."
2651 (interactive
2652 (list
2653 (unwind-protect
2654 (progn
2655 (unless (boundp 'apropos-do-all)
2656 (unless (require 'apropos nil t) (error "Library `apropos' not found")))
2657 (when (or current-prefix-arg apropos-do-all)
2658 (mapatoms (lambda (symb) (when (commandp symb) (put symb 'icicle-special-candidate t)))))
2659 (let* ((icicle-fancy-candidates-p (or current-prefix-arg apropos-do-all))
2660 (pred (if current-prefix-arg
2661 (lambda (s)
2662 (unless (symbolp s)
2663 (setq s (intern s)))
2664 (fboundp s))
2665 (lambda (s)
2666 (unless (symbolp s) (setq s (intern s)))
2667 (commandp s))))
2668 (icompletep (and (featurep 'icomplete) icomplete-mode))
2669 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))
2670 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn
2671 (icicle-alt-act-fn-for-type
2672 (if icicle-fancy-candidates-p
2673 "function"
2674 "command"))))
2675 (icicle-all-candidates-list-alt-action-fn ; `M-|'
2676 (or icicle-all-candidates-list-alt-action-fn
2677 (icicle-alt-act-fn-for-type (if icicle-fancy-candidates-p "function" "command")))))
2678 (completing-read
2679 (concat "Apropos " (if (or current-prefix-arg apropos-do-all)
2680 "command or function"
2681 "command")
2682 " (regexp" (and (>= emacs-major-version 22) " or words") "): ")
2683 obarray (and icompletep pred) nil nil 'regexp-history)))
2684 (when (or current-prefix-arg apropos-do-all)
2685 (mapatoms (lambda (symb) (put symb 'icicle-special-candidate nil)))))
2686 current-prefix-arg
2687 nil
2688 t))
2689 (when (and (> emacs-major-version 21) (require 'apropos nil t)
2690 (string= (regexp-quote pattern) pattern)
2691 (not (string= "" pattern)))
2692 (setq pattern (split-string pattern "[ \t]+" 'OMIT-NULLS)))
2693 (when (fboundp 'apropos-parse-pattern) (apropos-parse-pattern pattern)) ; Emacs 22+
2694 (when msgp (message (format "Gathering data apropos %s..." (if do-all "functions" "commands"))))
2695 (apropos-command pattern do-all var-predicate))))
2696
2697 (icicle-define-command icicle-apropos-options-of-type
2698 "Show user options of a given type.
2699 Enter patterns for the OPTION name and TYPE definition in the
2700 minibuffer, separated by `icicle-list-join-string', which is \"^G^J\",
2701 by default. (`^G' here means the Control-g character, input using
2702 `C-h C-g'. Likewise, for `^J'.)
2703
2704 OPTION is a regexp that is matched against option names.
2705
2706 See also:
2707 * `icicle-describe-option-of-type', which handles input and completion
2708 similarly, for a full description of TYPE, matching, and the use of
2709 a prefix argument
2710 * `icicle-apropos-value', using `C-$' to filter to options only" ; Doc string
2711 icicle-apropos-opt-action ; Action function
2712 prompt ; `completing-read' args
2713 'icicle-describe-opt-of-type-complete nil nil nil nil nil nil
2714 ((prompt "OPTION `C-M-j' TYPE: ") ; Bindings
2715 (icicle-multi-completing-p t)
2716 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
2717 ;; Bind `icicle-apropos-complete-match-fn' to nil to prevent automatic input matching
2718 ;; in `icicle-unsorted-apropos-candidates' etc., because `icicle-describe-opt-of-type-complete'
2719 ;; does everything.
2720 (icicle-apropos-complete-match-fn nil)
2721 (icicle-last-apropos-complete-match-fn 'icicle-multi-comp-apropos-complete-match)
2722 (icicle-candidate-help-fn 'icicle-describe-opt-action)
2723 (icicle-pref-arg current-prefix-arg))
2724 (progn (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code
2725 (icicle-highlight-lighter)
2726 (message "Gathering user options and their types...")))
2727
2728 (defun icicle-apropos-opt-action (opt+type)
2729 "Action function for `icicle-apropos-options-of-type'."
2730 (let ((icicle-list-use-nth-parts '(1)))
2731 (apropos-option (icicle-transform-multi-completion opt+type))))
2732
2733 (defun icicle-apropos-zippy (regexp)
2734 "Show all Zippy quotes matching the regular-expression REGEXP.
2735 Return the list of matches."
2736 (interactive (progn (unless (boundp 'yow-file)
2737 (unless (require 'yow nil t) (error "Library `yow' not found")))
2738 (cookie yow-file yow-load-message yow-after-load-message)
2739 (let* ((case-fold-search t)
2740 (cookie-table-symbol (intern yow-file cookie-cache))
2741 (string-table (symbol-value cookie-table-symbol))
2742 (table (nreverse (mapcar #'list string-table))))
2743 (list (completing-read "Apropos Zippy (regexp): " table
2744 nil nil nil 'regexp-history)))))
2745 (let ((matches (apropos-zippy icicle-current-input)))
2746 (when (interactive-p)
2747 (with-output-to-temp-buffer "*Zippy Apropos*"
2748 (while matches
2749 (princ (car matches))
2750 (setq matches (cdr matches))
2751 (and matches (princ "\n\n")))))
2752 matches)) ; Return matching Zippyisms.
2753
2754
2755 (put 'icicle-apropos-value 'icicle-turn-off-icomplete-mode t)
2756 (put 'icicle-apropos-value 'icicle-turn-off-incremental-completion t)
2757 (icicle-define-command icicle-apropos-value
2758 "Choose a variable, function, or other symbol description.
2759 This is similar to vanilla command `apropos-value', but you can match
2760 against the variable name and its printed value at the same time.
2761
2762 By default, each completion candidate is multi-completion composed of
2763 a variable name plus its value. They are separated by
2764 `icicle-list-join-string' \(\"^G^J\", by default).
2765
2766 With a prefix arg, candidates are different kinds of symbols:
2767
2768 < 0: functions and their defs (but byte-compiled defs are skipped)
2769 > 0: symbols and their plists
2770 = 0: variables and their values, functions and their definitions, and
2771 other symbols and their plists
2772
2773 plain (`C-u'): use the last-computed (cached) set of candidates
2774
2775 You can use `C-$' during completion to toggle filtering the domain of
2776 initial candidates according to the prefix argument, as follows:
2777
2778 none: only user options (+ values)
2779 < 0: only commands (+ definitions)
2780 > 0: only faces (+ plists)
2781 = 0: only options (+ values), commands (+ defs), faces (+ plists)
2782
2783 See also:
2784 * `icicle-apropos-vars-w-val-satisfying',
2785 `icicle-describe-vars-w-val-satisfying' - values satisfy a predicate
2786 * `icicle-plist' - similar to this command with positive prefix arg
2787 * `icicle-vardoc', `icicle-fundoc', `icicle-doc' - match name & doc
2788 * `icicle-apropos-options-of-type', `icicle-describe-option-of-type' -
2789 match name & defcustom type
2790
2791 Because you will often use this command in contexts that result in
2792 many, many completion candidates, the following are turned off by
2793 default for this command:
2794
2795 * Icomplete mode. You can toggle this using \\<minibuffer-local-completion-map>\
2796 `\\[icicle-toggle-icomplete-mode]'.
2797 * Icicles incremental completion. You can cycle this using `\\[icicle-cycle-incremental-completion]'."
2798 icicle-doc-action ; Action function
2799 prompt ; `completing-read' args
2800 (let ((cands (and (consp pref-arg) icicle-apropos-value-last-initial-cand-set))
2801 cand)
2802 (unless cands ; COLLECTION arg is an alist whose items are ((SYMB INFO)).
2803 (mapatoms (lambda (symb)
2804 ;; Exclude the local vars bound by this command. They are not what the user wants to see.
2805 (setq cand (and (not (memq symb '(cands pref-arg num-arg prompt
2806 icicle-toggle-transforming-message
2807 icicle-candidate-properties-alist
2808 icicle-multi-completing-p icicle-list-use-nth-parts
2809 icicle-transform-before-sort-p icicle-transform-function
2810 icicle-last-transform-function print-fn make-cand)))
2811 (funcall make-cand symb)))
2812 (when cand (push cand cands))))
2813 (setq icicle-apropos-value-last-initial-cand-set cands))
2814 cands)
2815 nil nil nil nil nil nil
2816 ((pref-arg current-prefix-arg) ; Bindings
2817 (num-arg (prefix-numeric-value pref-arg))
2818 (prompt (format "SYMBOL `C-M-j' %s: " (if pref-arg "INFO" "VALUE")))
2819 (icicle--last-toggle-transforming-msg icicle-toggle-transforming-message)
2820 (icicle-toggle-transforming-message (cond ((or (consp pref-arg) (= num-arg 0))
2821 "Filtering to OPTIONS, COMMANDS, & FACES is now %s")
2822 ((and pref-arg (> num-arg 0))
2823 "Filtering to FACES (+ plists) is now %s")
2824 ((< num-arg 0)
2825 "Filtering to COMMANDS (+ defs) is now %s")
2826 (t "Filtering to user OPTIONS (+ values) is now %s")))
2827 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
2828 (icicle-multi-completing-p t)
2829 (icicle-list-use-nth-parts '(1))
2830 (icicle-transform-before-sort-p t)
2831 (icicle-transform-function nil) ; No transformation: all symbols.
2832 (icicle-last-transform-function (lambda (cands) ; `C-$': only user options, commands, or faces.
2833 (loop for cc in cands
2834 with symb
2835 do (setq symb (intern
2836 (icicle-transform-multi-completion cc)))
2837 if (cond ((or (consp `,pref-arg) (= `,num-arg 0))
2838 (or (user-variable-p symb)
2839 (commandp symb)
2840 (facep symb)))
2841 ((and `,pref-arg (> `,num-arg 0))
2842 (facep symb))
2843 ((< `,num-arg 0)
2844 (commandp symb))
2845 (t
2846 (user-variable-p symb)))
2847 collect cc)))
2848 (print-fn (lambda (obj)
2849 (let ((print-circle t))
2850 ;;; $$$$$$ (condition-case nil
2851 ;;; (prin1-to-string obj)
2852 ;;; (error "`icicle-apropos-value' printing error")))))
2853 (prin1-to-string obj))))
2854 (make-cand (cond ((< num-arg 0) ; Function
2855 (lambda (symb)
2856 (and (fboundp symb)
2857 `((,(symbol-name symb)
2858 ,(if (byte-code-function-p (symbol-function symb))
2859 ""
2860 (funcall print-fn (symbol-function symb))))))))
2861 ((= num-arg 0) ; Do ALL
2862 (lambda (symb) ; Favor the var, then the fn, then the plist.
2863 (cond ((boundp symb)
2864 `((,(symbol-name symb)
2865 ,(funcall print-fn (symbol-value symb)))))
2866 ((fboundp symb)
2867 `((,(symbol-name symb)
2868 ,(if (byte-code-function-p (symbol-function symb))
2869 ""
2870 (funcall print-fn (symbol-function symb))))))
2871 ((symbol-plist symb)
2872 `((,(symbol-name symb)
2873 ,(funcall print-fn (symbol-plist symb))))))))
2874 ((and pref-arg (> num-arg 0)) ; Plist
2875 (lambda (symb)
2876 (and (symbol-plist symb)
2877 `((,(symbol-name symb)
2878 ,(funcall print-fn (symbol-plist symb)))))))
2879 (t ; Variable
2880 (lambda (symb)
2881 (and (boundp symb)
2882 `((,(symbol-name symb)
2883 ,(funcall print-fn (symbol-value symb))))))))))
2884 (progn (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code.
2885 (icicle-highlight-lighter)
2886 (message "Gathering %s%s..." (cond ((consp pref-arg) 'SYMBOLS)
2887 ((and pref-arg (< num-arg 0)) 'FUNCTIONS)
2888 ((and pref-arg (= num-arg 0)) "all SYMBOLS")
2889 ((and pref-arg (> num-arg 0)) 'SYMBOLS)
2890 (t 'VARIABLES))
2891 (cond ((consp pref-arg) " from last invocation (cached)")
2892 ((and pref-arg (< num-arg 0)) " and their definitions")
2893 ((and pref-arg (= num-arg 0)) " and their info")
2894 ((and pref-arg (> num-arg 0)) " and their plists")
2895 (t " and their values")))))
2896
2897
2898 (put 'icicle-describe-option-of-type 'icicle-turn-off-icomplete-mode t)
2899 (put 'icicle-describe-option-of-type 'icicle-turn-off-incremental-completion t)
2900 (icicle-define-command icicle-describe-option-of-type ; Bound to `C-h C-o'. Command name
2901 "Describe a user option that was defined with a given `defcustom' type.
2902 Enter patterns for the OPTION name and TYPE definition in the
2903 minibuffer, separated by `icicle-list-join-string', which is \"^G^J\",
2904 by default. (`^G' here means the Control-g character, input using
2905 `C-h C-g'. Likewise, for `^J'.)
2906
2907 Remember that you can insert `icicle-list-join-string' using `C-M-j'.
2908
2909 This command binds option `icicle-dot-string' to the value returned by
2910 function `icicle-anychar-regexp', for the duration, which means that
2911 `.' in your input to this command matches any character, including a
2912 newline char.
2913
2914 This is for convenience because `defcustom' type sexps are often
2915 multiline. This is particularly important for progressive completion,
2916 where your input definitely matches as a regexp (apropos completion).
2917 If you do not want `.' to match newlines, use `C-M-.' during the
2918 command.
2919
2920 Example use of progressive completion:
2921
2922 1. C-h C-o ici C-M-j choic S-TAB
2923
2924 That shows all options whose names are apropos-matched by `ici' and
2925 whose types are matched by `choic'.
2926
2927 2. S-SPC om C-M-j sexp
2928
2929 That limits the matches to options whose names also match `om' and
2930 whose types also match `sexp'.'
2931
2932
2933 OPTION is a regexp that is matched against option names.
2934
2935 Depending on the prefix arg, TYPE is interpreted as either of these:
2936
2937 - a regexp to match against the option type
2938
2939 - a definition acceptable for `defcustom' :type, or its first symbol,
2940 for example, (choice (integer) (regexp)) or `choice'
2941
2942 In the second case, depending on the prefix arg, TYPE can be matched
2943 against the option type, or it can be matched against either the
2944 option type or one of its subtypes.
2945
2946 In the second case also, depending on the prefix arg, if TYPE does not
2947 match some option's type, that option might still be a candidate, if
2948 its current value satisfies TYPE.
2949
2950 In sum, the prefix arg determines the type-matching behavior, as
2951 follows:
2952
2953 - None: OPTION is defined with TYPE or a subtype of TYPE.
2954 TYPE is a regexp.
2955
2956 - `C-u': OPTION is defined with TYPE or a subtype of TYPE,
2957 or its current value is compatible with TYPE.
2958 TYPE is a type definition or its first symbol.
2959
2960 - Negative: OPTION is defined with TYPE (exact match).
2961 TYPE is a regexp.
2962
2963 - Positive: OPTION is defined with TYPE,
2964 or its current value is compatible with TYPE.
2965 TYPE is a type definition or its first symbol.
2966
2967 - Zero: OPTION is defined with TYPE or a subtype of TYPE.
2968 TYPE is a type definition or its first symbol.
2969
2970 - `C-u C-u': OPTION is defined with TYPE (exact match).
2971 TYPE is a type definition or its first symbol.
2972
2973 You can change these prefix-arg key sequences by customizing option
2974 `icicle-option-type-prefix-arg-list'. For example, if you tend to use
2975 the matching defined here for `C-u', you might want to make that the
2976 default behavior (no prefix arg). You can assign any of the six
2977 behaviors to any of the prefix-arg keys.
2978
2979 If TYPE is nil, then *all* options that match OPTION are candidates.
2980
2981 Note that options defined in libraries that have not been loaded can
2982 be candidates, but their type will appear as nil, since it is not
2983 known before loading the option definition.
2984
2985 You can match your input against the option name or the type
2986 definition or both. Use `C-M-j' (equivalent here to `C-q C-g C-j') to
2987 input the default separator.
2988
2989 For example, to match all Icicles options whose type matches `string'
2990 \(according to the prefix arg), use `S-TAB' with this input:
2991
2992 icicle C-M-j string$
2993
2994 If you instead want all Icicles options whose type definition contains
2995 `string', as in (repeat string), then use this:
2996
2997 icicle C-M-j string
2998
2999 See also:
3000 * `icicle-apropos-options-of-type', to show options of a given type
3001 * `icicle-apropos-value', using `C-$' to filter to options only
3002
3003 Because you will often use this command in contexts that result in
3004 many, many completion candidates, the following are turned off by
3005 default for this command:
3006
3007 * Icomplete mode. You can toggle this using \\<minibuffer-local-completion-map>\
3008 `\\[icicle-toggle-icomplete-mode]'.
3009 * Icicles incremental completion. You can cycle this using `\\[icicle-cycle-incremental-completion]'."
3010 icicle-describe-opt-action ; Action function
3011 prompt ; `completing-read' args
3012 'icicle-describe-opt-of-type-complete nil nil nil nil nil nil
3013 ((prompt "OPTION `C-M-j' TYPE: ") ; Bindings
3014 (icicle-multi-completing-p t)
3015 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
3016 (icicle-dot-string (icicle-anychar-regexp))
3017 ;; Bind `icicle-apropos-complete-match-fn' to nil to prevent automatic input matching
3018 ;; in `icicle-unsorted-apropos-candidates' etc., because `icicle-describe-opt-of-type-complete'
3019 ;; does everything.
3020 (icicle-apropos-complete-match-fn nil)
3021 (icicle-last-apropos-complete-match-fn 'icicle-multi-comp-apropos-complete-match)
3022 (icicle-candidate-help-fn 'icicle-describe-opt-action)
3023 ;; $$$ (icicle-highlight-input-completion-failure nil)
3024 (icicle-pref-arg current-prefix-arg))
3025 (progn (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code
3026 (icicle-highlight-lighter)
3027 (message "Gathering user options and their types...")))
3028
3029 (defun icicle-describe-opt-action (opt+type)
3030 "Action function for `icicle-describe-option-of-type'."
3031 (let ((icicle-list-use-nth-parts '(1)))
3032 (describe-variable (intern (icicle-transform-multi-completion opt+type)))))
3033
3034 ;; Free var here: `icicle-pref-arg' - it is bound in `icicle-describe-option-of-type'.
3035 (defun icicle-describe-opt-of-type-complete (strg pred completion-mode)
3036 "Completion function for `icicle-describe-option-of-type'.
3037 This is used as the value of `minibuffer-completion-table'."
3038 (setq strg icicle-current-input)
3039 ;; Parse strg into its option part and its type part: OPS and TPS.
3040 ;; Make raw alist of all options and their types: ((a . ta) (b . tb)...).
3041 (lexical-let* ((num-prefix (prefix-numeric-value icicle-pref-arg))
3042 (mode (cond ((not icicle-pref-arg) ; No prefix arg
3043 (nth 4 icicle-option-type-prefix-arg-list))
3044 ((and (consp icicle-pref-arg) (= 16 num-prefix)) ; C-u C-u
3045 (nth 0 icicle-option-type-prefix-arg-list))
3046 ((consp icicle-pref-arg) (nth 2 icicle-option-type-prefix-arg-list)) ; C-u
3047 ((zerop num-prefix) (nth 1 icicle-option-type-prefix-arg-list)) ; C-0
3048 ((wholenump num-prefix) ; C-9
3049 (nth 3 icicle-option-type-prefix-arg-list))
3050 (t (nth 5 icicle-option-type-prefix-arg-list)))) ; C--
3051 (ops (let ((icicle-list-use-nth-parts '(1)))
3052 (icicle-transform-multi-completion strg)))
3053 (tps (let ((icicle-list-use-nth-parts '(2)))
3054 (icicle-transform-multi-completion strg)))
3055 (tp (and (not (string= "" tps))
3056 ;; Use regexp if no prefix arg or negative; else use sexp.
3057 (if (memq mode '(inherit-or-regexp direct-or-regexp)) tps (read tps))))
3058 (result ()))
3059 (mapatoms
3060 (lambda (symb) ; FREE here: RESULT.
3061 (when (if (fboundp 'custom-variable-p) (custom-variable-p symb) (user-variable-p symb))
3062 (condition-case nil
3063 (push (list symb (get symb 'custom-type)) result)
3064 (error nil)))))
3065 ;; Keep only candidates that correspond to input.
3066 (setq result
3067 (lexical-let ((ops-re (if (memq icicle-current-completion-mode '(nil apropos))
3068 ops
3069 (concat "^" (regexp-quote ops)))))
3070 (icicle-remove-if-not
3071 (lambda (opt+typ) ; FREE here: OPS-RE, MODE, TP.
3072 (and (string-match ops-re (symbol-name (car opt+typ)))
3073 (or (null tp)
3074 (condition-case nil
3075 (icicle-var-is-of-type-p (car opt+typ) (list tp)
3076 (case mode
3077 ((inherit inherit-or-regexp) 'inherit)
3078 ((direct direct-or-regexp) 'direct)
3079 (inherit-or-value 'inherit-or-value)
3080 (direct-or-value 'direct-or-value)))
3081 (error nil)))))
3082 result)))
3083 ;; Change alist entries to multi-completions: "op^G^Jtp". Add short help for mode-line, tooltip.
3084 (setq result
3085 ;; FREE here: ICICLE-HELP-IN-MODE-LINE-DELAY, ICICLE-LIST-JOIN-STRING, TOOLTIP-MODE.
3086 (mapcar (lambda (entry)
3087 (let* ((opt+typ-string
3088 ;; $$$$$$ (mapconcat (lambda (e) (pp-to-string e)) entry icicle-list-join-string))
3089 (mapconcat (lambda (e) (pp-to-string e)) entry icicle-list-join-string))
3090 (doc ; Don't bother to look up doc, if user won't see it.
3091 (and (or (> icicle-help-in-mode-line-delay 0)
3092 (and (boundp 'tooltip-mode) tooltip-mode))
3093 (documentation-property (car entry) 'variable-documentation t)))
3094 (doc1 (and (stringp doc) (string-match ".+$" doc) (match-string 0 doc))))
3095 (when doc1 (icicle-candidate-short-help doc1 opt+typ-string))
3096 opt+typ-string))
3097 result))
3098 (if completion-mode
3099 result ; `all-completions', `test-completion'
3100 (try-completion ; `try-completion'
3101 strg (mapcar #'list result) (and pred (lambda (ss) (funcall pred ss)))))))
3102
3103 (defun icicle-apropos-vars-w-val-satisfying (predicate pattern &optional optionp)
3104 "Show variables whose values satisfy PREDICATE and names match PATTERN.
3105 You are prompted for a predicate sexp and a pattern matching the
3106 variable names. For the latter, before hitting `RET' you must use
3107 completion (`S-TAB' or `TAB') to manifest the set of matching
3108 variables. Apropos information is shown for those variables when you
3109 hit `RET'.
3110
3111 The predicate sexp must be a function symbol or a lambda form that
3112 accepts the value of the variable as its (first) argument.
3113
3114 Typically the predicate is a type predicate, such as `integerp', but
3115 it could be anything. Instead of just `integerp', for example, it
3116 could be `(lambda (val) (and (integerp val) (> val 5) (< val 15)))'.
3117
3118 With a prefix argument, candidates are limited to user options.
3119
3120 See also: `icicle-apropos-value', which matches names and values."
3121 (interactive (icicle-read-args-w-val-satisfying "Apropos var (hit `S-TAB' or `TAB'): "
3122 current-prefix-arg t))
3123 (if optionp
3124 (if (fboundp 'icicle-apropos-option)
3125 (icicle-apropos-option pattern)
3126 (icicle-apropos-variable pattern t))
3127 (icicle-apropos-variable pattern)))
3128
3129 (defun icicle-customize-apropos-opts-w-val-satisfying (predicate pattern)
3130 "Customize options whose values satisfy PREDICATE and names match PATTERN.
3131 You are prompted for a predicate sexp and a pattern matching the
3132 option names. For the latter, before hitting `RET' you must use
3133 completion (`S-TAB' or `TAB') to manifest the set of matching options.
3134 A Customize buffer is opened for those options when you hit `RET'.
3135
3136 The predicate sexp must be a function symbol or a lambda form that
3137 accepts the value of the variable as its (first) argument.
3138
3139 Typically the predicate is a type predicate, such as `integerp', but
3140 it could be anything. Instead of just `integerp', for example, it
3141 could be `(lambda (val) (and (integerp val) (> val 5) (< val 15)))'."
3142 (interactive (let ((xxx (icicle-read-args-w-val-satisfying "Customize vars (hit `S-TAB' or `TAB'): "
3143 t t)))
3144 (list (car xxx) (cadr xxx))))
3145 (icicle-customize-apropos-options pattern))
3146
3147 (defun icicle-read-args-w-val-satisfying (prompt optionp patternp)
3148 "Read args for `icicle-*-w-val-satisfying' commands.
3149 Prompt for the variable names using PROMPT.
3150 Non-nil OPTIONP means allow only variables that are user options. It
3151 is used here during completion of the variable name, and it is
3152 returned as the third arg for `icicle-describe-var-w-val-satisfying'.
3153
3154 Non-nil PATTERNP means return as the variable whatever input pattern
3155 the user entered. Otherwise, assume the pattern names a variable, and
3156 return the symbol with that name."
3157 (let* ((enable-recursive-minibuffers t)
3158 (valpred
3159 (let ((string-read nil)
3160 (read-result nil))
3161 (condition-case err
3162 (prog1 (setq read-result (read (setq string-read (completing-read
3163 "Predicate to satify: "
3164 icicle-predicate-types-alist
3165 nil nil nil
3166 (if (boundp 'function-name-history)
3167 'function-name-history
3168 'icicle-function-name-history)))))
3169 (unless (functionp read-result) (error ""))) ; Read was OK, but not a function.
3170 (error (error "Invalid function: `%s'" string-read))))) ; Read error.
3171 (vardflt (or (and (fboundp 'symbol-nearest-point)
3172 (symbol-nearest-point))
3173 (and (symbolp (variable-at-point))
3174 (variable-at-point))))
3175 (symbpred (if optionp #'user-variable-p #'boundp))
3176 (varpred `(lambda (sy)
3177 (unless (symbolp sy) (setq sy (intern sy)))
3178 (and
3179 (funcall #',symbpred sy)
3180 (funcall #',valpred (symbol-value sy)))))
3181 (icompletep (and (featurep 'icomplete) icomplete-mode))
3182 (icicle-must-pass-after-match-predicate (and (not icompletep) varpred))
3183 (varpat (completing-read
3184 prompt obarray (and icompletep varpred) nil nil nil
3185 (and vardflt (symbol-name vardflt)) t)))
3186 (list valpred
3187 (if patternp
3188 (if icicle-completion-candidates
3189 (regexp-opt icicle-completion-candidates)
3190 (message "Predicate %s. You did not complete var names (`S-TAB' or `TAB')"
3191 (icicle-propertize "IGNORED" 'face 'icicle-msg-emphasis))
3192 (sit-for 3)
3193 varpat)
3194 (intern varpat))
3195 optionp)))
3196
3197
3198 ;; REPLACE ORIGINAL `repeat-complex-command' defined in `simple.el',
3199 ;; saving it for restoration when you toggle `icicle-mode'.
3200 ;;
3201 ;; Uses `completing-read' to read the command to repeat, letting you use `S-TAB' and
3202 ;; `TAB' to see the history list and `C-,' to toggle sorting that display.
3203 ;;
3204 (unless (fboundp 'icicle-ORIG-repeat-complex-command)
3205 (defalias 'icicle-ORIG-repeat-complex-command (symbol-function 'repeat-complex-command)))
3206
3207 (defun icicle-repeat-complex-command (arg) ; Bound to `C-x ESC ESC', `C-x M-:' in Icicle mode.
3208 "Edit and re-evaluate the last complex command, or ARGth from last.
3209 A complex command is one that used the minibuffer.
3210 ARG is the prefix argument numeric value.
3211
3212 You can edit the past command you choose before executing it. The
3213 Lisp form of the command is used. If the command you enter differs
3214 from the previous complex command, then it is added to the front of
3215 the command history.
3216
3217 Icicles completion is available for choosing a past command. You can
3218 still use the vanilla Emacs bindings `\\<minibuffer-local-map>\\[next-history-element]' and \
3219 `\\[previous-history-element]' to cycle inputs,
3220 and `\\[repeat-matching-complex-command]' to match regexp input, but Icicles input cycling (`up',
3221 `down', `next', `prior', `home', `end') and apropos completion
3222 \(`S-TAB') are superior and more convenient."
3223 (interactive "p")
3224 (let ((elt (nth (1- arg) command-history))
3225 newcmd)
3226 (if elt
3227 (progn
3228 (setq newcmd
3229 (let ((print-level nil)
3230 (minibuffer-history-position arg)
3231 (minibuffer-history-sexp-flag (1+ (minibuffer-depth))))
3232 (unwind-protect
3233 (let ((icicle-transform-function 'icicle-remove-duplicates))
3234 (read (completing-read
3235 "Redo: " (mapcar (lambda (entry) (list (prin1-to-string entry)))
3236 command-history)
3237 nil nil (prin1-to-string elt) (cons 'command-history arg)
3238 (prin1-to-string elt))))
3239 ;; If command was added to command-history as a string, get rid of that.
3240 ;; We want only evaluable expressions there.
3241 (and (stringp (car command-history))
3242 (setq command-history (cdr command-history))))))
3243 ;; If command to be redone does not match front of history, add it to the history.
3244 (unless (equal newcmd (car command-history))
3245 (setq command-history (cons newcmd command-history)))
3246 ;; Trick `called-interactively-p' into thinking that this is an interactive call of NEWCMD
3247 ;; (Emacs bug #14136).
3248 (if (or (> emacs-major-version 24)
3249 (and (= emacs-major-version 24) (not (version< emacs-version "24.3.50"))))
3250 (unwind-protect
3251 (progn (add-hook 'called-interactively-p-functions
3252 #'icicle-repeat-complex-command--called-interactively-skip)
3253 (eval newcmd))
3254 (remove-hook 'called-interactively-p-functions
3255 #'icicle-repeat-complex-command--called-interactively-skip))
3256 (eval newcmd)))
3257 (if command-history
3258 (icicle-user-error "Argument %d is beyond length of command history" arg)
3259 (icicle-user-error "There are no previous complex commands to repeat")))))
3260
3261 ;; Same as `repeat-complex-command--called-interactively-skip' in `simple.el', but tests for
3262 ;; `icicle-repeat-complex-command', not `repeat-complex-command'.
3263 (when (or (> emacs-major-version 24)
3264 (and (= emacs-major-version 24) (not (version< emacs-version "24.3.50"))))
3265 (defun icicle-repeat-complex-command--called-interactively-skip (i _frame1 frame2)
3266 "If currently `icicle-repeat-complex-command', return 1 to skip over it."
3267 (and (eq 'eval (cadr frame2)) (eq 'icicle-repeat-complex-command
3268 (cadr (backtrace-frame i #'called-interactively-p)))
3269 1))
3270 (byte-compile 'icicle-repeat-complex-command))
3271
3272 (defun icicle-add-entry-to-saved-completion-set (set-name entry type)
3273 "Add ENTRY to saved completion-candidates set SET-NAME.
3274 ENTRY is normally a single candidate (a string).
3275 With a prefix arg, however, and if option
3276 `icicle-filesets-as-saved-completion-sets-flag' is non-nil, then
3277 ENTRY is the name of an Emacs fileset (Emacs 22 or later).
3278 TYPE is the type of entry to add: `Fileset' or `Candidate'."
3279 (interactive
3280 (let ((typ (if (and current-prefix-arg icicle-filesets-as-saved-completion-sets-flag
3281 (prog1 (or (require 'filesets nil t)
3282 (error "Feature `filesets' not provided"))
3283 (filesets-init))
3284 filesets-data)
3285 'Fileset
3286 'Candidate)))
3287 (list
3288 (save-selected-window
3289 (completing-read "Saved completion set: " icicle-saved-completion-sets nil t nil
3290 'icicle-completion-set-history))
3291 (if (eq typ 'Fileset)
3292 (list ':fileset ; Just save the fileset name, not the data.
3293 (car (assoc (completing-read "Fileset to add: " filesets-data nil t)
3294 filesets-data)))
3295 (completing-read "Candidate to add: " (mapcar #'list icicle-saved-completion-candidates)))
3296 typ)))
3297 (let ((file-name (cdr (assoc set-name icicle-saved-completion-sets))))
3298 (unless (icicle-file-readable-p file-name) (error "Cannot read cache file `%s'" file-name))
3299 (let ((list-buf (find-file-noselect file-name 'NOWARN 'RAW))
3300 candidates newcands entry-type)
3301 (unwind-protect
3302 (condition-case icicle-add-entry-to-saved-completion-set
3303 (when (listp (setq newcands (setq candidates (read list-buf))))
3304 (message "Set `%s' read from file `%s'" set-name file-name))
3305 (error (error "Bad cache file. %s"
3306 (error-message-string icicle-add-entry-to-saved-completion-set))))
3307 (kill-buffer list-buf))
3308 (unless (consp newcands) (error "Bad data in cache file `%s'" file-name))
3309 (pushnew entry newcands :test #'equal)
3310 (setq entry (if (eq type 'Fileset) (caar entry) entry))
3311 (if (= (length candidates) (length newcands))
3312 (message "%s `%s' is already in saved set `%s', file `%s'" type entry set-name file-name)
3313 (with-temp-message (format "Writing entry to cache file `%s'..." file-name)
3314 (with-temp-file file-name (prin1 newcands (current-buffer))))
3315 (message "%s `%s' added to saved set `%s', file `%s'" type
3316 (icicle-propertize entry 'face 'icicle-msg-emphasis)
3317 (icicle-propertize set-name 'face 'icicle-msg-emphasis)
3318 (icicle-propertize file-name 'face 'icicle-msg-emphasis))))))
3319
3320 (defun icicle-remove-entry-from-saved-completion-set (set-name)
3321 "Remove an entry from saved completion-candidates set SET-NAME.
3322 SET-NAME can be an Icicles saved completions set (cache file) or the
3323 name of an Emacs fileset.
3324
3325 The entry to remove can be a single completion candidate (a string) or
3326 an Emacs fileset. You can thus remove a file name from a fileset or
3327 remove a fileset from an Icicles saved completion set. (You can also
3328 remove a file name from a saved completion set.) If a saved set has
3329 both a file and a fileset of the same name, then both are removed.
3330
3331 To use filesets here, use Emacs 22 or later, load library `filesets',
3332 use `(filesets-init)', and ensure that option
3333 `icicle-filesets-as-saved-completion-sets-flag' is non-nil."
3334 (interactive
3335 (list (completing-read "Saved completion set: "
3336 (if (and icicle-filesets-as-saved-completion-sets-flag
3337 (featurep 'filesets) filesets-data)
3338 (append filesets-data icicle-saved-completion-sets)
3339 icicle-saved-completion-sets)
3340 nil t nil 'icicle-completion-set-history)))
3341 (let* ((file-name (cdr (assoc set-name icicle-saved-completion-sets)))
3342 (candidates (icicle-get-candidates-from-saved-set
3343 set-name 'dont-expand))
3344 (icicle-whole-candidate-as-text-prop-p t)
3345 (icicle-remove-icicles-props-p nil) ; Need prop `icicle-whole-candidate' for now.
3346 (entry
3347 (funcall icicle-get-alist-candidate-function
3348 (completing-read
3349 "Candidate to remove: "
3350 (mapcar (lambda (e)
3351 (cond ((icicle-saved-fileset-p e) ; Swap `:fileset' with fileset name
3352 `(,(cadr e) ,(car e) ,@(cddr e)))
3353 ((consp e) e)
3354 (t (list e)))) ; Listify naked string.
3355 candidates)
3356 nil t))))
3357 (when (and (consp entry) (eq (cadr entry) ':fileset)) ; Swap back again: `:fileset' and name.
3358 (setq entry `(,(cadr entry) ,(car entry) ,@(cddr entry))))
3359 (when (and (consp entry) (null (cdr entry))) (setq entry (car entry))) ; Use just the string.
3360 ;; Delete any such candidate, then remove text properties used for completion.
3361 (setq candidates (mapcar #'icicle-unpropertize-completion (delete entry candidates)))
3362 (cond (file-name
3363 (with-temp-message ; Remove from cache file.
3364 (format "Writing remaining candidates to cache file `%s'..." file-name)
3365 (with-temp-file file-name (prin1 candidates (current-buffer)))))
3366 ((icicle-saved-fileset-p (list ':fileset set-name)) ; Remove from fileset.
3367 (unless (require 'filesets nil t) (error "Feature `filesets' not provided"))
3368 (filesets-init)
3369 (let ((fst (and filesets-data (assoc set-name filesets-data)))) ; The fileset itself.
3370 (unless fst (error "No such fileset: `%s'" set-name))
3371 (let ((fst-files (filesets-entry-get-files fst)))
3372 (if (car (filesets-member entry fst-files :test 'filesets-files-equalp))
3373 (if fst-files ; Similar to code in `filesets-remove-buffer'.
3374 (let ((new-fst (list (cons ':files (delete entry fst-files)))))
3375 (setcdr fst new-fst)
3376 (filesets-set-config set-name 'filesets-data filesets-data))
3377 (message "Cannot remove `%s' from fileset `%s'"
3378 (icicle-propertize entry 'face 'icicle-msg-emphasis)
3379 (icicle-propertize set-name 'face 'icicle-msg-emphasis)))
3380 (message "`%s' not in fileset `%s'"
3381 (icicle-propertize entry 'face 'icicle-msg-emphasis)
3382 (icicle-propertize set-name 'face 'icicle-msg-emphasis)))))))
3383 (when entry
3384 (icicle-msg-maybe-in-minibuffer
3385 "`%s' removed from %s `%s'%s"
3386 (icicle-propertize (if (icicle-saved-fileset-p entry) (cadr entry) entry)
3387 'face 'icicle-msg-emphasis)
3388 (if (icicle-saved-fileset-p entry) "fileset" "saved set")
3389 (icicle-propertize set-name 'face 'icicle-msg-emphasis)
3390 (if file-name
3391 (format ", file `%s'" (icicle-propertize file-name'face 'icicle-msg-emphasis))
3392 "")))))
3393
3394 (icicle-define-command icicle-remove-saved-completion-set ; Command name
3395 "Remove an entry from `icicle-saved-completion-sets'.
3396 Save the updated option.
3397 You are prompted to also delete the associated cache file.
3398 You can add entries to `icicle-saved-completion-sets' using command
3399 `icicle-add/update-saved-completion-set'." ; Doc string
3400 icicle-remove-saved-set-action
3401 "Remove set of completion candidates named: " ; `completing-read' args
3402 icicle-saved-completion-sets nil t nil 'icicle-completion-set-history nil nil
3403 ((icicle-whole-candidate-as-text-prop-p t) ; Additional bindings
3404 (icicle-use-candidates-only-once-flag t))
3405 nil nil (icicle-remove-Completions-window)) ; First code, undo code, last code
3406
3407 (defun icicle-remove-saved-set-action (set-name)
3408 "Remove saved set SET-NAME from `icicle-saved-completion-sets'."
3409 (let ((enable-recursive-minibuffers t)
3410 (sets icicle-saved-completion-sets)
3411 set cache)
3412 (save-selected-window
3413 (select-window (minibuffer-window))
3414 (while (setq set (assoc set-name sets)
3415 cache (cdr set))
3416 (when (file-exists-p cache)
3417 (if (y-or-n-p (format "Delete cache file `%s'? "
3418 (icicle-propertize cache 'face 'icicle-msg-emphasis)))
3419 (when (condition-case err
3420 (progn (delete-file cache) t)
3421 (error (progn (message "%s" (error-message-string err)) nil)))
3422 (message "%s `%s'" (icicle-propertize "DELETED" 'face 'icicle-msg-emphasis) cache)
3423 (sit-for 1))
3424 (message "OK, file NOT deleted") (sit-for 1)))
3425 (setq sets (delete set sets)))))
3426 (setq icicle-saved-completion-sets
3427 (icicle-assoc-delete-all set-name icicle-saved-completion-sets))
3428 (funcall icicle-customize-save-variable-function
3429 'icicle-saved-completion-sets
3430 icicle-saved-completion-sets)
3431 (message "Candidate set `%s' removed" (icicle-propertize set-name 'face 'icicle-msg-emphasis)))
3432
3433 (defun icicle-bookmark-save-marked-files (&optional arg) ; Bound to `C-M->' in *Bookmark List*.
3434 "Save file names of marked bookmarks as a set of completion candidates.
3435 Saves file names in variable `icicle-saved-completion-candidates', by
3436 default. Marked bookmarks that have no associated file are ignored.
3437 With a plain prefix arg (`C-u'), save candidates in a cache file.
3438 With a non-zero numeric prefix arg (`C-u N'), save candidates in a
3439 variable for which you are prompted.
3440 With a zero prefix arg (`C-0'), save candidates in a fileset (Emacs 22
3441 or later). Use this only for file-name candidates, obviously.
3442 To subsequently use a fileset for candidate retrieval, option
3443 `icicle-filesets-as-saved-completion-sets-flag' must be non-nil.
3444
3445 You can retrieve the saved set of file-name candidates during
3446 completion using `\\<minibuffer-local-completion-map>\\[icicle-candidate-set-retrieve]'.
3447 You can use the saved set of candidates for operations such as
3448 \\<minibuffer-local-completion-map>
3449 `icicle-candidate-set-union' (`\\[icicle-candidate-set-union]'),
3450 `icicle-candidate-set-intersection' (`\\[icicle-candidate-set-intersection]'), and
3451 `icicle-candidate-set-difference' (`\\[icicle-candidate-set-difference]').
3452
3453 You can use this command only from a bookmark-list display buffer
3454 \(`*Bookmark List*')."
3455 (interactive "P")
3456 (unless (fboundp 'bmkp-bmenu-get-marked-files)
3457 (icicle-user-error "You need library `Bookmark+' for this command"))
3458 (bmkp-bmenu-barf-if-not-in-menu-list)
3459 (icicle-candidate-set-save-1 (bmkp-bmenu-get-marked-files) arg))
3460
3461 (defun icicle-bookmark-save-marked-files-more (&optional arg) ; Bound to `C->' in *Bookmark List*.
3462 "Add the file names of the marked bookmarks to the saved candidates set.
3463 Marked bookmarks that have no associated file are ignored.
3464 Add candidates to `icicle-saved-completion-candidates', by default.
3465 A prefix argument acts the same as for `icicle-candidate-set-save'.
3466
3467 The existing saved candidates remain saved. The current candidates
3468 are added to those already saved.
3469
3470 You can retrieve the saved set of candidates with `C-M-<'.
3471 You can use the saved set of candidates for operations such as
3472 \\<minibuffer-local-completion-map>
3473 `icicle-candidate-set-union' (`\\[icicle-candidate-set-union]'),
3474 `icicle-candidate-set-intersection' (`\\[icicle-candidate-set-intersection]'), and
3475 `icicle-candidate-set-difference' (`\\[icicle-candidate-set-difference]').
3476
3477 You can use this command only from a bookmark-list display buffer
3478 \(`*Bookmark List*')."
3479 (interactive "P")
3480 (unless (fboundp 'bmkp-bmenu-get-marked-files)
3481 (icicle-user-error "You need library `Bookmark+' for this command"))
3482 (bmkp-bmenu-barf-if-not-in-menu-list)
3483 (icicle-candidate-set-save-1 (bmkp-bmenu-get-marked-files) arg t))
3484
3485 (defun icicle-bookmark-save-marked-files-to-variable () ; Bound to `C-M-}' in *Bookmark List*.
3486 "Save the file names of the marked bookmarks to a variable.
3487 Marked bookmarks that have no associated file are ignored.
3488
3489 You can retrieve the saved set of file-name candidates during
3490 completion using `\\<minibuffer-local-completion-map>\\[icicle-candidate-set-retrieve]'.
3491 You can use the saved set of candidates for operations such as
3492 \\<minibuffer-local-completion-map>
3493 `icicle-candidate-set-union' (`\\[icicle-candidate-set-union]'),
3494 `icicle-candidate-set-intersection' (`\\[icicle-candidate-set-intersection]'), and
3495 `icicle-candidate-set-difference' (`\\[icicle-candidate-set-difference]').
3496
3497 You can use this command only from a bookmark-list display buffer
3498 \(`*Bookmark List*')."
3499 (interactive)
3500 (unless (fboundp 'bmkp-bmenu-get-marked-files)
3501 (icicle-user-error "You need library `Bookmark+' for this command"))
3502 (bmkp-bmenu-barf-if-not-in-menu-list)
3503 (icicle-candidate-set-save-1 (bmkp-bmenu-get-marked-files) 99))
3504
3505 (defalias 'icicle-bookmark-save-marked-files-as-project ; Bound to `C-}' in *Bookmark List*.
3506 'icicle-bookmark-save-marked-files-persistently)
3507 (defun icicle-bookmark-save-marked-files-persistently (filesetp)
3508 "Save the file names of the marked bookmarks as a persistent set.
3509 Marked bookmarks that have no associated file are ignored.
3510 With no prefix arg, save in a cache file.
3511 With a prefix arg, save in an Emacs fileset (Emacs 22 or later).
3512
3513 You can retrieve the saved set of file-name candidates during
3514 completion using `\\<minibuffer-local-completion-map>\\[icicle-candidate-set-retrieve]'.
3515 You can use the saved set of candidates for operations such as
3516 \\<minibuffer-local-completion-map>
3517 `icicle-candidate-set-union' (`\\[icicle-candidate-set-union]'),
3518 `icicle-candidate-set-intersection' (`\\[icicle-candidate-set-intersection]'), and
3519 `icicle-candidate-set-difference' (`\\[icicle-candidate-set-difference]').
3520
3521 You can use this command only from a bookmark-list display buffer
3522 \(`*Bookmark List*')."
3523 (interactive "P")
3524 (unless (fboundp 'bmkp-bmenu-get-marked-files)
3525 (icicle-user-error "You need library `Bookmark+' for this command"))
3526 (bmkp-bmenu-barf-if-not-in-menu-list)
3527 (icicle-candidate-set-save-1 (bmkp-bmenu-get-marked-files) (if filesetp 0 '(1))))
3528
3529
3530 (defun icicle-dired-save-marked (&optional arg) ; Bound to `C-M->' in Dired.
3531 "Save the marked file names in Dired as a set of completion candidates.
3532 Saves file names in variable `icicle-saved-completion-candidates', by
3533 default.
3534 With a plain prefix arg (`C-u'), save candidates in a cache file.
3535 With a non-zero numeric prefix arg (`C-u N'), save candidates in a
3536 variable for which you are prompted.
3537 With a zero prefix arg (`C-0'), save candidates in a fileset (Emacs 22
3538 or later). Use this only for file-name candidates, obviously.
3539 To subsequently use a fileset for candidate retrieval, option
3540 `icicle-filesets-as-saved-completion-sets-flag' must be non-nil.
3541
3542 You can retrieve the saved set of file-name candidates during
3543 completion using `\\<minibuffer-local-completion-map>\\[icicle-candidate-set-retrieve]'.
3544 You can use the saved set of candidates for operations such as
3545 \\<minibuffer-local-completion-map>
3546 `icicle-candidate-set-union' (`\\[icicle-candidate-set-union]'),
3547 `icicle-candidate-set-intersection' (`\\[icicle-candidate-set-intersection]'), and
3548 `icicle-candidate-set-difference' (`\\[icicle-candidate-set-difference]').
3549
3550 You can use this command only from a Dired buffer."
3551 (interactive "P")
3552 (unless (eq major-mode 'dired-mode)
3553 (icicle-user-error "You must be in a Dired buffer to use this command"))
3554 (icicle-candidate-set-save-1 (dired-get-marked-files) arg))
3555
3556 (defun icicle-dired-save-marked-more (&optional arg) ; Bound to `C->' in Dired.
3557 "Add the marked file names in Dired to the saved candidates set.
3558 Like `icicle-dired-save-marked', but add file names to those already
3559 saved, if any. A prefix argument has the same effect as for
3560 `icicle-dired-save-marked'."
3561 (interactive "P")
3562 (unless (eq major-mode 'dired-mode)
3563 (icicle-user-error "You must be in a Dired buffer to use this command"))
3564 (icicle-candidate-set-save-1 (dired-get-marked-files) arg t))
3565
3566 (defun icicle-dired-save-marked-to-variable () ; Bound to `C-M-}' in Dired.
3567 "Save the marked file names in Dired to a variable as a candidate set.
3568 Same as using `icicle-dired-save-marked' with no prefix argument."
3569 (interactive)
3570 (unless (eq major-mode 'dired-mode)
3571 (icicle-user-error "You must be in a Dired buffer to use this command"))
3572 (icicle-candidate-set-save-1 (dired-get-marked-files) 99))
3573
3574 (defalias 'icicle-dired-save-marked-as-project ; Bound to `C-}' in Dired.
3575 'icicle-dired-save-marked-persistently)
3576 (defun icicle-dired-save-marked-persistently (filesetp)
3577 "Save the marked file names in Dired as a persistent set.
3578 With no prefix arg, save in a cache file.
3579 With a prefix arg, save in an Emacs fileset (Emacs 22 or later).
3580
3581 You can retrieve the saved set of file-name candidates during
3582 completion using `\\<minibuffer-local-completion-map>\\[icicle-candidate-set-retrieve]'.
3583 You can use the saved set of candidates for operations such as
3584 \\<minibuffer-local-completion-map>
3585 `icicle-candidate-set-union' (`\\[icicle-candidate-set-union]'),
3586 `icicle-candidate-set-intersection' (`\\[icicle-candidate-set-intersection]'), and
3587 `icicle-candidate-set-difference' (`\\[icicle-candidate-set-difference]').
3588
3589 You can use this command only from a Dired buffer."
3590 (interactive "P")
3591 (unless (eq major-mode 'dired-mode)
3592 (icicle-user-error "You must be in a Dired buffer to use this command"))
3593 (icicle-candidate-set-save-1 (dired-get-marked-files) (if filesetp 0 '(1))))
3594
3595
3596 ;;; These commands require library `Dired+'.
3597 ;;;
3598 (when (fboundp 'diredp-get-files) ; In Dired+.
3599 (defun icicle-dired-save-marked-recursive (&optional ignore-marks-p arg) ; Bound to `M-+ C-M->' in Dired.
3600 "Save the marked file names in Dired, including those in marked subdirs.
3601 Like `icicle-dired-save-marked', but act recursively on subdirs.
3602
3603 The files included are those that are marked in the current Dired
3604 buffer, or all files in the directory if none are marked. Marked
3605 subdirectories are handled recursively in the same way.
3606
3607 With a prefix argument, ignore all marks - include all files in this
3608 Dired buffer and all subdirs, recursively.
3609
3610 You need library `Dired+' for this command."
3611 (interactive (progn
3612 (unless (fboundp 'diredp-get-confirmation-recursive)
3613 (icicle-user-error "You need library `dired+.el' for this command"))
3614 (diredp-get-confirmation-recursive)
3615 (list current-prefix-arg 1)))
3616 (icicle-candidate-set-save-1 (diredp-get-files ignore-marks-p) arg))
3617
3618 (defun icicle-dired-save-marked-more-recursive (&optional ignore-marks-p arg) ; Bound to `M-+ C->' in Dired.
3619 "Add marked files, including those in marked subdirs, to saved candidates.
3620 Like `icicle-dired-save-marked-more', but act recursively on subdirs.
3621
3622 The files included are those that are marked in the current Dired
3623 buffer, or all files in the directory if none are marked. Marked
3624 subdirectories are handled recursively in the same way.
3625
3626 With a prefix argument, ignore all marks - include all files in this
3627 Dired buffer and all subdirs, recursively.
3628
3629 You need library `Dired+' for this command."
3630 (interactive (progn
3631 (unless (fboundp 'diredp-get-confirmation-recursive)
3632 (icicle-user-error "You need library `dired+.el' for this command"))
3633 (diredp-get-confirmation-recursive)
3634 (list current-prefix-arg 1)))
3635 (icicle-candidate-set-save-1 (diredp-get-files ignore-marks-p) arg t))
3636
3637 (defun icicle-dired-save-marked-to-variable-recursive (&optional ignore-marks-p) ; `M-+ C-M-}' in Dired.
3638 "Save marked files, including those in marked subdirs, to a variable.
3639 Like `icicle-dired-save-marked-to-variable', but act recursively on subdirs.
3640
3641 The files included are those that are marked in the current Dired
3642 buffer, or all files in the directory if none are marked. Marked
3643 subdirectories are handled recursively in the same way.
3644
3645 With a prefix argument, ignore all marks - include all files in this
3646 Dired buffer and all subdirs, recursively.
3647
3648 You need library `Dired+' for this command."
3649 (interactive (progn
3650 (unless (fboundp 'diredp-get-confirmation-recursive)
3651 (icicle-user-error "You need library `dired+.el' for this command"))
3652 (diredp-get-confirmation-recursive)
3653 (list current-prefix-arg)))
3654 (icicle-candidate-set-save-1 (diredp-get-files ignore-marks-p) 99))
3655
3656 (defun icicle-dired-save-marked-to-cache-file-recursive (&optional ignore-marks-p) ; `M-+ C-}' in Dired.
3657 "Save marked files, including in marked subdirs, to an Icicles cache set.
3658 Like `icicle-dired-save-marked-persistently' with no prefix arg, but
3659 act recursively on subdirs.
3660
3661 The files included are those that are marked in the current Dired
3662 buffer, or all files in the directory if none are marked. Marked
3663 subdirectories are handled recursively in the same way.
3664
3665 With a prefix argument, ignore all marks - include all files in this
3666 Dired buffer and all subdirs, recursively.
3667
3668 You need library `Dired+' for this command."
3669 (interactive (progn
3670 (unless (fboundp 'diredp-get-confirmation-recursive)
3671 (icicle-user-error "You need library `dired+.el' for this command"))
3672 (diredp-get-confirmation-recursive)
3673 (list current-prefix-arg)))
3674 (icicle-candidate-set-save-1 (diredp-get-files ignore-marks-p) '(1)))
3675
3676 (defun icicle-dired-save-marked-to-fileset-recursive (&optional ignore-marks-p) ; Not bound by default.
3677 "Save marked files, including those in marked subdirs, to an Emacs fileset.
3678 Like `icicle-dired-save-marked-persistently' with no prefix arg, but
3679 act recursively on subdirs.
3680
3681 The files included are those that are marked in the current Dired
3682 buffer, or all files in the directory if none are marked. Marked
3683 subdirectories are handled recursively in the same way.
3684
3685 With a prefix argument, ignore all marks - include all files in this
3686 Dired buffer and all subdirs, recursively.
3687
3688 You need library `Dired+' for this command."
3689 (interactive (progn
3690 (unless (fboundp 'diredp-get-confirmation-recursive)
3691 (icicle-user-error "You need library `dired+.el' for this command"))
3692 (unless (require 'filesets nil t)
3693 (error "Cannot save to a fileset - feature `filesets' not provided"))
3694 (diredp-get-confirmation-recursive)
3695 (list current-prefix-arg)))
3696 (icicle-candidate-set-save-1 (diredp-get-files ignore-marks-p) 0)))
3697
3698 (when (and (> emacs-major-version 21) ; Emacs 20 has no PREDICATE arg to `read-file-name'.
3699 (fboundp 'diredp-insert-as-subdir))
3700 (icicle-define-file-command icicle-dired-insert-as-subdir
3701 "Choose a directory. Insert it into a Dired ancestor listing.
3702 If the directory you choose has a Dired buffer then its markings and
3703 switches are preserved for the subdir listing in the ancestor Dired
3704 buffer.
3705
3706 You need library `Dired+' for this command."
3707 (lambda (dir) (diredp-insert-as-subdir dir ancestor-dir)) ; FREE here: ANCESTOR-DIR.
3708 "Insert directory into ancestor Dired: " ; `read-file-name' args
3709 default-directory nil t nil `(lambda (ff)
3710 (and (file-directory-p (expand-file-name ff))
3711 (dired-in-this-tree (expand-file-name ff) ',ancestor-dir)))
3712 ((ancestor-dir ; Bindings
3713 (completing-read "Ancestor Dired dir to insert into: "
3714 (cons (list default-directory)
3715 (mapcar #'list (diredp-ancestor-dirs default-directory))))))))
3716
3717
3718 (put 'icicle-dired-saved-file-candidates 'icicle-Completions-window-max-height 200)
3719 (defalias 'icicle-dired-chosen-files 'icicle-dired-saved-file-candidates)
3720 (defun icicle-dired-saved-file-candidates (prompt-for-dir-p)
3721 "Open Dired on a set of files and directories of your choice.
3722 If you have saved a set of file names using \\<minibuffer-local-completion-map>\
3723 `\\[icicle-candidate-set-save]', then it is used.