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