Update icicles
[emacs.git] / .emacs.d / elisp / icicle / icicles-cmd2.el
1 ;;; icicles-cmd2.el --- Top-level commands for Icicles
2 ;;
3 ;; Filename: icicles-cmd2.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: Thu May 21 13:31:43 2009 (-0700)
9 ;; Last-Updated: Mon Jan 26 09:24:48 2015 (-0800)
10 ;; By: dradams
11 ;; Update #: 7111
12 ;; URL: http://www.emacswiki.org/icicles-cmd2.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-cmd1', `icicles-fn', `icicles-mcmd', `icicles-opt',
27 ;; `icicles-var', `image-dired', `info', `info+20', `kmacro',
28 ;; `levenshtein', `menu-bar', `menu-bar+', `misc-cmds', `misc-fns',
29 ;; `mouse3', `mwheel', `naked', `package', `pp', `pp+',
30 ;; `regexp-opt', `ring', `second-sel', `strings', `thingatpt',
31 ;; `thingatpt+', `unaccent', `w32browser-dlgopen', `wid-edit',
32 ;; `wid-edit+', `widget'.
33 ;;
34 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
35 ;;
36 ;;; Commentary:
37 ;;
38 ;; This is a helper library for library `icicles.el'. It defines
39 ;; top-level commands (and a few non-interactive functions used in
40 ;; those commands). This is a continuation of library
41 ;; `icicles-cmd1.el' (a single file for all top-level commands would
42 ;; be too large to upload to Emacs Wiki).
43 ;;
44 ;; For commands to be used mainly in the minibuffer or buffer
45 ;; `*Completions*', see `icicles-mcmd.el'.
46 ;;
47 ;; For Icicles documentation, see `icicles-doc1.el' and
48 ;; `icicles-doc2.el'.
49 ;;
50 ;; If you use the byte-compiled version of this library,
51 ;; `icicles-cmd2.elc', in Emacs 23, then it must be byte-compiled
52 ;; using Emacs 23. Otherwise, Icicles key completion (and perhaps
53 ;; other things?) will not work correctly.
54 ;;
55 ;; Macros defined here:
56 ;;
57 ;; `icicle-search-modes', `icicle-with-comments-hidden'.
58 ;;
59 ;; Widgets defined here:
60 ;;
61 ;; `icicle-color', `icicle-ORIG-color'.
62 ;;
63 ;; Commands defined here - (+) means a multi-command:
64 ;;
65 ;; (+)`a', (+)`any', (+)`buffer', (+)`file', (+)`icicle-anything',
66 ;; (+)`icicle-apply', (+)`icicle-bookmark-a-file',
67 ;; (+)`icicle-bookmark-tagged',
68 ;; (+)`icicle-bookmark-tagged-other-window',
69 ;; (+)`icicle-choose-faces', (+)`icicle-choose-invisible-faces',
70 ;; (+)`icicle-choose-visible-faces', (+)`icicle-comint-command',
71 ;; (+)`icicle-comint-search', (+)`icicle-compilation-search',
72 ;; `icicle-complete', (+)`icicle-complete-keys',
73 ;; (+)`icicle-complete-menu-bar',
74 ;; `icicle-complete-thesaurus-entry', `icicle-describe-package',
75 ;; (+)`icicle-doc', (+)`icicle-exchange-point-and-mark',
76 ;; (+)`icicle-find-file-all-tags',
77 ;; (+)`icicle-find-file-all-tags-other-window',
78 ;; (+)`icicle-find-file-all-tags-regexp',
79 ;; (+)`icicle-find-file-all-tags-regexp-other-window',
80 ;; (+)`icicle-find-file-handle-bookmark',
81 ;; (+)`icicle-find-file-handle-bookmark-other-window',
82 ;; (+)`icicle-find-file-some-tags',
83 ;; (+)`icicle-find-file-some-tags-other-window',
84 ;; (+)`icicle-find-file-some-tags-regexp',
85 ;; (+)`icicle-find-file-some-tags-regexp-other-window',
86 ;; (+)`icicle-find-file-tagged',
87 ;; (+)`icicle-find-file-tagged-other-window', (+)`icicle-font',
88 ;; (+)`icicle-font-lock-keyword', (+)`icicle-frame-bg',
89 ;; (+)`icicle-frame-fg', (+)`icicle-fundoc',
90 ;; (+)`icicle-goto-any-marker', (+)`icicle-goto-global-marker',
91 ;; (+)`icicle-goto-global-marker-or-pop-global-mark',
92 ;; (+)`icicle-goto-marker',
93 ;; (+)`icicle-goto-marker-or-set-mark-command',
94 ;; (+)`icicle-hide-faces', (+)`icicle-hide-only-faces',
95 ;; `icicle-hide/show-comments', (+)`icicle-imenu',
96 ;; (+)`icicle-imenu-command', (+)`icicle-imenu-command-full',
97 ;; (+)`icicle-imenu-face', (+)`icicle-imenu-face-full',
98 ;; (+)`icicle-imenu-full', (+)`icicle-imenu-key-explicit-map',
99 ;; (+)`icicle-imenu-key-explicit-map-full',
100 ;; (+)`icicle-imenu-key-implicit-map',
101 ;; (+)`icicle-imenu-key-implicit-map-full',
102 ;; (+)`icicle-imenu-macro', (+)`icicle-imenu-macro-full',
103 ;; (+)`icicle-imenu-non-interactive-function',
104 ;; (+)`icicle-imenu-non-interactive-function-full',
105 ;; (+)`icicle-imenu-user-option',
106 ;; (+)`icicle-imenu-user-option-full', (+)`icicle-imenu-variable',
107 ;; (+)`icicle-imenu-variable-full', `icicle-ido-like-mode',
108 ;; (+)`icicle-Info-goto-node',
109 ;; (+)`icicle-Info-goto-node-no-search',
110 ;; (+)`icicle-Info-goto-node-of-content', (+)`icicle-Info-index',
111 ;; (+)`icicle-Info-index-20', (+)`icicle-Info-menu',
112 ;; (+)`icicle-Info-menu-cmd', `icicle-Info-virtual-book',
113 ;; (+)`icicle-insert-thesaurus-entry', (+)`icicle-load-library',
114 ;; (+)`icicle-map', `icicle-next-font-lock-keywords',
115 ;; `icicle-next-font-lock-keywords-repeat',
116 ;; `icicle-next-visible-thing', `icicle-non-whitespace-string-p',
117 ;; (+)`icicle-object-action', (+)`icicle-occur',
118 ;; (+)`icicle-occur-dired-marked',
119 ;; (+)`icicle-occur-dired-marked-recursive',
120 ;; (+)`icicle-pick-color-by-name', (+)`icicle-plist',
121 ;; `icicle-previous-visible-thing', `icicle-read-color',
122 ;; `icicle-read-color-WYSIWYG', `icicle-save-string-to-variable',
123 ;; (+)`icicle-search', (+)`icicle-search-all-tags-bookmark',
124 ;; (+)`icicle-search-all-tags-regexp-bookmark',
125 ;; (+)`icicle-search-autofile-bookmark',
126 ;; (+)`icicle-search-autonamed-bookmark',
127 ;; (+)`icicle-search-bookmark',
128 ;; (+)`icicle-search-bookmark-list-bookmark',
129 ;; `icicle-search-bookmark-list-marked',
130 ;; (+)`icicle-search-bookmarks-together',
131 ;; (+)`icicle-search-buffer', (+)`icicle-search-buff-menu-marked',
132 ;; (+)`icicle-search-char-property', (+)`icicle-search-defs',
133 ;; (+)`icicle-search-defs-full', (+)`icicle-search-dired-bookmark',
134 ;; (+)`icicle-search-dired-marked',
135 ;; (+)`icicle-search-dired-marked-recursive',
136 ;; (+)`icicle-search-file', (+)`icicle-search-file-bookmark',
137 ;; (+)`icicle-search-generic', (+)`icicle-search-gnus-bookmark',
138 ;; `icicle-search-highlight-cleanup',
139 ;; (+)`icicle-search-ibuffer-marked',
140 ;; (+)`icicle-search-info-bookmark', (+)`icicle-search-keywords',
141 ;; (+)`icicle-search-lines',
142 ;; (+)`icicle-search-local-file-bookmark',
143 ;; (+)`icicle-search-man-bookmark',
144 ;; (+)`icicle-search-non-file-bookmark',
145 ;; (+)`icicle-search-overlay-property',
146 ;; (+)`icicle-search-paragraphs', (+)`icicle-search-pages',
147 ;; (+)`icicle-search-region-bookmark',
148 ;; (+)`icicle-search-remote-file-bookmark',
149 ;; (+)`icicle-search-sentences',
150 ;; (+)`icicle-search-some-tags-bookmark',
151 ;; (+)`icicle-search-some-tags-regexp-bookmark',
152 ;; (+)`icicle-search-specific-buffers-bookmark',
153 ;; (+)`icicle-search-specific-files-bookmark',
154 ;; (+)`icicle-search-temporary-bookmark',
155 ;; (+)`icicle-search-text-property', (+)`icicle-search-thing',
156 ;; (+)`icicle-search-this-buffer-bookmark',
157 ;; (+)`icicle-search-url-bookmark',
158 ;; `icicle-search-w-isearch-string',
159 ;; (+)`icicle-search-w3m-bookmark', (+)`icicle-search-word',
160 ;; (+)`icicle-search-xml-element',
161 ;; (+)`icicle-search-xml-element-text-node',
162 ;; (+)`icicle-select-frame', `icicle-select-frame-by-name',
163 ;; (+)`icicle-select-text-at-point',
164 ;; `icicle-set-S-TAB-methods-for-command',
165 ;; `icicle-set-TAB-methods-for-command', (+)`icicle-show-faces',
166 ;; (+)`icicle-show-only-faces', (+)`icicle-synonyms',
167 ;; (+)`icicle-tag-a-file', (+)`icicle-tags-search',
168 ;; (+)`icicle-untag-a-file', (+)`icicle-vardoc',
169 ;; (+)`icicle-where-is', (+)`icicle-wide-n', (+)`synonyms',
170 ;; (+)`what-which-how'.
171 ;;
172 ;; Non-interactive functions defined here:
173 ;;
174 ;; `icicle-add-key+cmd', `icicle-anything-candidate-value',
175 ;; `icicle-apply-action', `icicle-apply-list-action',
176 ;; `icicle-char-properties-in-buffer',
177 ;; `icicle-char-properties-in-buffers',
178 ;; `icicle-choose-anything-candidate',
179 ;; `icicle-choose-candidate-of-type',
180 ;; `icicle-color-from-multi-completion-input',
181 ;; `icicle-cmd2-after-load-bookmark+',
182 ;; `icicle-cmd2-after-load-hexrgb',
183 ;; `icicle-cmd2-after-load-highlight',
184 ;; `icicle-cmd2-after-load-palette',
185 ;; `icicle-cmd2-after-load-synonyms',
186 ;; `icicle-cmd2-after-load-wid-edit+', `icicle-color-blue-lessp',
187 ;; `icicle-color-completion-setup',
188 ;; `icicle-color-distance-hsv-lessp',
189 ;; `icicle-color-distance-rgb-lessp', `icicle-color-green-lessp',
190 ;; `icicle-color-help', `icicle-color-hsv-lessp',
191 ;; `icicle-color-hue-lessp', `icicle-color-red-lessp',
192 ;; `icicle-color-saturation-lessp', `icicle-color-value-lessp',
193 ;; `icicle-comint-hook-fn',
194 ;; `icicle-comint-search-get-final-choice',
195 ;; `icicle-comint-search-get-minibuffer-input',
196 ;; `icicle-comint-search-send-input', `icicle-compilation-hook-fn',
197 ;; `icicle-compilation-search-in-context-fn',
198 ;; `icicle-complete-keys-1', `icicle-complete-keys-action',
199 ;; `icicle-doc-action', `icicle-fn-doc-minus-sig',
200 ;; `icicle-get-anything-actions-for-type',
201 ;; `icicle-get-anything-cached-candidates',
202 ;; `icicle-get-anything-candidates',
203 ;; `icicle-get-anything-candidates-of-type',
204 ;; `icicle-get-anything-default-actions-for-type',
205 ;; `icicle-get-anything-input-delay',
206 ;; `icicle-get-anything-req-pat-chars',
207 ;; `icicle-get-anything-types', `icicle-goto-marker-1',
208 ;; `icicle-goto-marker-1-action', `icicle-group-regexp',
209 ;; `icicle-imenu-command-p', `icicle-imenu-help',
210 ;; `icicle-imenu-in-buffer-p', `icicle-imenu-macro-p',
211 ;; `icicle-imenu-non-interactive-function-p',
212 ;; `icicle-Info-apropos-complete-match',
213 ;; `icicle-Info-build-node-completions',
214 ;; `icicle-Info-build-node-completions-1',
215 ;; `icicle-Info-content-match', `icicle-Info-goto-node-1',
216 ;; `icicle-Info-goto-node-action', `icicle-Info-index-action',
217 ;; `icicle-Info-multi-read-node-name',
218 ;; `icicle-Info-read-node-name',
219 ;; `icicle-Info-read-node-of-content',
220 ;; `icicle-insert-thesaurus-entry-cand-fn',
221 ;; `icicle-invisible-face-p', `icicle-invisible-p',
222 ;; `icicle-keys+cmds-w-prefix', `icicle-make-color-candidate',
223 ;; `icicle-marker+text', `icicle-markers',
224 ;; `icicle-next-single-char-property-change',
225 ;; `icicle-next-visible-thing-1', `icicle-next-visible-thing-2',
226 ;; `icicle-next-visible-thing-and-bounds',
227 ;; `icicle-ORIG-read-color', `icicle-ORIG-widget-color-complete',
228 ;; `icicle-pick-color-by-name-1',
229 ;; `icicle-pick-color-by-name-action',
230 ;; `icicle-previous-single-char-property-change',
231 ;; `icicle-read-args-for-set-completion-methods',
232 ;; `icicle-read-var-value-satisfying',
233 ;; `icicle-region-or-buffer-limits', `icicle-same-vector-keyseq-p',
234 ;; `icicle-search-action', `icicle-search-action-1',
235 ;; `icicle-search-bookmark-action',
236 ;; `icicle-search-char-property-scan',
237 ;; `icicle-search-char-prop-matches-p',
238 ;; `icicle-search-choose-buffers', `icicle-search-cleanup',
239 ;; `icicle-search-define-candidates',
240 ;; `icicle-search-define-candidates-1',
241 ;; `icicle-search-dired-marked-recursive-1',
242 ;; `icicle-search-file-found-p', `icicle-search-final-act',
243 ;; `icicle-search-help',
244 ;; `icicle-search-highlight-all-input-matches',
245 ;; `icicle-search-highlight-and-maybe-replace',
246 ;; `icicle-search-highlight-input-matches-here',
247 ;; `icicle-search-in-context-default-fn',
248 ;; `icicle-search-property-args',
249 ;; `icicle-search-property-default-match-fn',
250 ;; `icicle-search-quit-or-error',
251 ;; `icicle-search-read-context-regexp', `icicle-search-read-word',
252 ;; `icicle-search-regexp-scan',
253 ;; `icicle-search-replace-all-search-hits',
254 ;; `icicle-search-replace-cand-in-alist',
255 ;; `icicle-search-replace-cand-in-mct',
256 ;; `icicle-search-replace-fixed-case-p',
257 ;; `icicle-search-replace-match',
258 ;; `icicle-search-replace-search-hit', `icicle-search-thing-args',
259 ;; `icicle-search-thing-scan', `icicle-search-where-arg',
260 ;; `icicle-set-completion-methods-for-command',
261 ;; `icicle-things-alist', `icicle-this-command-keys-prefix',
262 ;; `icicle-update-f-l-keywords', `icicle-wide-n-action',
263 ;; `icicle-widget-color-complete', `icicle-WYSIWYG-font'.
264 ;;
265 ;; Internal variables defined here:
266 ;;
267 ;; `icicle-active-map', `icicle-info-buff', `icicle-info-window',
268 ;; `icicle-key-prefix', `icicle-key-prefix-2',
269 ;; `icicle-last-thing-type', `icicle-named-colors',
270 ;; `icicle-orig-extra-cands', `icicle-orig-font',
271 ;; `icicle-orig-frame', `icicle-orig-menu-bar',
272 ;; `icicle-orig-pixelsize', `icicle-orig-pointsize',
273 ;; `icicle-orig-show-initially-flag',
274 ;; `icicle-orig-sort-orders-alist', `icicle-search-regexp',
275 ;; `icicle-this-cmd-keys'.
276 ;;
277 ;;
278 ;; Key bindings made by Icicles: See "Key Bindings" in
279 ;; `icicles-doc2.el'.
280 ;;
281 ;; For descriptions of changes to this file, see `icicles-chg.el'.
282
283 ;;(@> "Index")
284 ;;
285 ;; If you have library `linkd.el' and Emacs 22 or later, load
286 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
287 ;; navigate around the sections of this doc. Linkd mode will
288 ;; highlight this Index, as well as the cross-references and section
289 ;; headings throughout this file. You can get `linkd.el' here:
290 ;; http://dto.freeshell.org/notebook/Linkd.html.
291 ;;
292 ;; (@> "Icicles Commands for Other Packages")
293 ;; (@> "Icicles Top-Level Commands, Part 2")
294
295 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
296 ;;
297 ;; This program is free software; you can redistribute it and/or
298 ;; modify it under the terms of the GNU General Public License as
299 ;; published by the Free Software Foundation; either version 3, or
300 ;; (at your option) any later version.
301 ;;
302 ;; This program is distributed in the hope that it will be useful,
303 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
304 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
305 ;; General Public License for more details.
306 ;;
307 ;; You should have received a copy of the GNU General Public License
308 ;; along with this program; see the file COPYING. If not, write to
309 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
310 ;; Floor, Boston, MA 02110-1301, USA.
311 ;;
312 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
313 ;;
314 ;;; Code:
315
316 (eval-when-compile (require 'cl)) ;; case, loop, pushnew
317 ;; plus, for Emacs < 21: dolist, push
318 (eval-when-compile (when (>= emacs-major-version 22) (require 'edmacro))) ;; edmacro-subseq
319 (eval-when-compile (require 'comint))
320 ;; comint-check-proc, comint-copy-old-input, comint-get-old-input, comint-input-ring,
321 ;; comint-prompt-regexp, comint-send-input
322 (eval-when-compile (require 'completion)) ;; completion-string
323 (eval-when-compile (require 'imenu)) ;; imenu-syntax-alist
324 (eval-when-compile (require 'compile)) ;; compilation-find-buffer
325 (eval-when-compile (require 'info)) ;; Info-goto-node
326 (eval-when-compile (require 'etags)) ;; tags-case-fold-search, tags-table-files,
327 ;; visit-tags-table-buffer
328 (eval-when-compile (when (> emacs-major-version 21)
329 (require 'anything nil t))) ;; (no error if not found):
330 ;; anything-candidate-cache, anything-get-sources, anything-idle-delay, anything-pattern,
331 ;; anything-sources, anything-transform-candidates
332 (require 'strings nil t) ;; (no error if not found): read-number (my version)
333 (eval-when-compile (require 'bookmark+ nil t)) ;; (no error if not found):
334 ;; bmkp-bmenu-barf-if-not-in-menu-list, bmkp-bmenu-get-marked-files, bmkp-bookmark-last-access-cp,
335 ;; bmkp-buffer-last-access-cp, bmkp-describe-bookmark, bmkp-describe-bookmark-internals,
336 ;; bmkp-file-alpha-cp, bmkp-get-buffer-name, bmkp-get-end-position, bmkp-get-tags, bmkp-gnus-cp,
337 ;; bmkp-handler-cp, bmkp-info-cp, bmkp-local-file-accessed-more-recently-cp,
338 ;; bmkp-local-file-size-cp, bmkp-local-file-type-cp, bmkp-local-file-updated-more-recently-cp,
339 ;; bmkp-marked-cp, bmkp-non-file-filename, bmkp-read-tags-completing, bmkp-region-alist-only,
340 ;; bmkp-region-bookmark-p, bmkp-sorted-alist, bmkp-sort-omit, bmkp-url-cp, bmkp-visited-more-cp
341 (eval-when-compile (require 'hexrgb nil t)) ;; (no error if not found):
342 ;; hexrgb-color-name-to-hex, hexrgb-defined-colors, hexrgb-defined-colors-alist, hexrgb-hex-to-hsv,
343 ;; hexrgb-hex-to-rgb, hexrgb-read-color, hexrgb-(red|green|blue|hue|saturation|value),
344 ;; hexrgb-rgb-hex-string-p, hexrgb-rgb-to-hsv, hexrgb-value
345 (eval-when-compile (require 'highlight nil t)) ;; (no error if not found):
346 ;; hlt-act-on-any-face-flag, hlt-hide-default-face, hlt-highlight-faces-in-buffer,
347 ;; hlt-region-or-buffer-limits, hlt-show-default-face
348 (eval-when-compile
349 (or (condition-case nil
350 (load-library "icicles-mac") ; Use load-library to ensure latest .elc.
351 (error nil))
352 (require 'icicles-mac))) ; Require, so can load separately if not on `load-path'.
353 ;; icicle-bind-file-candidate-keys, icicle-define-command, icicle-define-file-command,
354 ;; icicle-file-bindings, icicle-unbind-file-candidate-keys
355 (require 'icicles-mcmd)
356 ;; icicle-search-define-replacement
357 (require 'icicles-opt) ; (This is required anyway by `icicles-var.el'.)
358 ;; icicle-act-before-cycle-flag, icicle-alternative-sort-comparer, icicle-buffer-extras,
359 ;; icicle-buffer-ignore-space-prefix-flag, icicle-buffer-match-regexp, icicle-buffer-no-match-regexp,
360 ;; icicle-buffer-predicate, icicle-buffer-require-match-flag, icicle-buffer-sort,
361 ;; icicle-complete-keys-ignored-prefix-keys, icicle-complete-keys-self-insert-ranges,
362 ;; icicle-delete-candidate-object, icicle-key-descriptions-use-<>-flag, icicle-recenter,
363 ;; icicle-require-match-flag, icicle-saved-completion-sets, icicle-search-cleanup-flag, icicle-kbd,
364 ;; icicle-search-highlight-all-current-flag, icicle-search-highlight-threshold, icicle-search-hook,
365 ;; icicle-sort-comparer, icicle-sort-orders-alist, icicle-transform-function
366 (require 'icicles-var) ; (This is required anyway by `icicles-fn.el'.)
367 ;; icicle-abs-file-candidates, icicle-acting-on-next/prev, icicle-all-candidates-action,
368 ;; icicle-all-candidates-list-action-fn, icicle-all-candidates-list-alt-action-fn, icicle-apply-nomsg,
369 ;; icicle-apropos-complete-match-fn, icicle-buffer-sort-first-time-p, icicle-candidate-action-fn,
370 ;; icicle-candidate-alt-action-fn, icicle-candidate-entry-fn, icicle-candidate-help-fn, icicle-candidate-nb,
371 ;; icicle-candidate-properties-alist, icicle-candidates-alist, icicle-complete-keys-alist,
372 ;; icicle-completing-keys-p, icicle-completion-candidates, icicle-current-completion-mode,
373 ;; icicle-current-input, icicle-doc-last-initial-cand-set, icicle-explore-final-choice,
374 ;; icicle-explore-final-choice-full, icicle-extra-candidates, icicle-extra-candidates-dir-insert-p,
375 ;; icicle-full-cand-fn, icicle-fundoc-last-initial-cand-set, icicle-get-alist-candidate-function,
376 ;; icicle-hist-cands-no-highlight, icicle-hist-var, icicle-Info-only-rest-of-book-p,
377 ;; icicle-Info-tag-table-posn, icicle-key-prefix-description, icicle-last-apropos-complete-match-fn,
378 ;; icicle-last-completion-candidate, icicle-last-completion-command, icicle-last-input,
379 ;; icicle-last-sort-comparer, icicle-last-transform-function, icicle-list-use-nth-parts,
380 ;; icicle-minibuffer-message-ok-p, icicle-mode-line-help, icicle-multi-completing-p, icicle-must-match-regexp,
381 ;; icicle-must-not-match-regexp, icicle-must-pass-after-match-predicate, icicle-nb-of-other-cycle-candidates,
382 ;; icicle-orig-buff, icicle-orig-pt-explore, icicle-orig-window, icicle-orig-win-explore, icicle-other-window,
383 ;; icicle-plist-last-initial-cand-set, icicle-predicate-types-alist, icicle-pref-arg, icicle-prompt,
384 ;; icicle-proxy-candidate-regexp, icicle-proxy-candidates, icicle-require-match-p,
385 ;; icicle-saved-completion-candidate, icicle-saved-completion-candidates, icicle-scan-fn-or-regexp,
386 ;; icicle-search-command, icicle-search-complement-domain-p, icicle-search-context-level,
387 ;; icicle-search-context-regexp, icicle-search-current-overlay, icicle-search-final-choice,
388 ;; icicle-search-in-context-fn, icicle-searching-p, icicle-search-level-overlays, icicle-search-modes,
389 ;; icicle-search-overlays, icicle-search-refined-overlays, icicle-search-replacement,
390 ;; icicle-transform-before-sort-p, icicle-vardoc-last-initial-cand-set, icicle-whole-candidate-as-text-prop-p
391 (require 'icicles-fn) ; (This is required anyway by `icicles-mcmd.el'.)
392 ;; icicle-alist-key-match, icicle-candidate-short-help, icicle-completing-read-history,
393 ;; icicle-defined-thing-p, icicle-highlight-lighter, icicle-insert-cand-in-minibuffer, icicle-some,
394 ;; icicle-read-regexp, icicle-string-match-p, icicle-unlist
395 (require 'icicles-cmd1)
396 ;; icicle-bookmark-cleanup, icicle-bookmark-cleanup-on-quit, icicle-bookmark-cmd, icicle-bookmark-help-string,
397 ;; icicle-bookmark-propertize-candidate, icicle-buffer-list, icicle-explore, icicle-face-list,
398 ;; icicle-file-list, icicle-keyword-list, icicle-make-bookmark-candidate, icicle-make-frame-alist,
399 ;; icicle-select-bookmarked-region
400
401 ;;; (require 'icicles-mode)
402 ;;; ;; icicle-ORIG-Info-goto-node, icicle-ORIG-Info-index, icicle-ORIG-Info-menu
403
404
405
406 ;; Byte-compiling this file, you will likely get some byte-compiler warning messages.
407 ;; These are probably benign - ignore them. Icicles is designed to work with multiple
408 ;; versions of Emacs, and that fact provokes compiler warnings. If you get byte-compiler
409 ;; errors (not warnings), then please report a bug, using `M-x icicle-send-bug-report'.
410
411 ;;; Some defvars to quiet byte-compiler a bit:
412
413 (defvar anything-sources) ; In `anything.el'
414 (defvar anything-candidate-cache) ; In `anything.el'
415 (defvar anything-idle-delay) ; In `anything.el'
416 (defvar bmkp-non-file-filename) ; In `bookmark+-1.el'
417 (defvar bmkp-sorted-alist) ; In `bookmark+-1.el'
418 (defvar cmpl-cdabbrev-reset-p) ; In `completion.el'
419 (defvar cmpl-current-index) ; In `completion.el'
420 (defvar cmpl-initialized-p) ; In `completion.el'
421 (defvar cmpl-last-insert-location) ; In `completion.el'
422 (defvar cmpl-leave-point-at-start) ; In `completion.el'
423 (defvar cmpl-obarray) ; In `completion.el'
424 (defvar cmpl-original-string) ; In `completion.el'
425 (defvar cmpl-cdabbrev-reset-p) ; In `completion.el'
426 (defvar cmpl-symbol-end) ; In `completion.el'
427 (defvar cmpl-symbol-start) ; In `completion.el'
428 (defvar cmpl-test-regexp) ; In `completion.el'
429 (defvar cmpl-test-string) ; In `completion.el'
430 (defvar cmpl-tried-list) ; In `completion.el'
431 (defvar completion-cdabbrev-prompt-flag) ; In `completion.el'
432 (defvar completion-prefix-min-length) ; In `completion.el'
433 (defvar completion-prompt-speed-threshold) ; In `completion.el'
434 (defvar completion-to-accept) ; In `completion.el'
435 (defvar er/try-expand-list) ; In `expand-region.el'
436 (defvar eyedrop-picked-background) ; In `eyedrop.el' or `palette.el'
437 (defvar eyedrop-picked-foreground) ; In `eyedrop.el' or `palette.el'
438 (defvar hlt-act-on-any-face-flag) ; In `highlight.el'
439 (defvar icicle-complete-keys-ignored-prefix-keys) ; In `icicles-var.el' (Emacs 22+)
440 (defvar icicle-complete-keys-self-insert-ranges) ; In `icicles-var.el' (Emacs 22+)
441 (defvar icicle-face-completing-p) ; Here
442 (defvar icicle-package-completing-p) ; Here
443 (defvar icicle-search-ecm) ; In `icicle-search'
444 (defvar icicle-track-pt) ; In `icicle-insert-thesaurus-entry'
445 (defvar imenu-after-jump-hook) ; In `imenu.el' (Emacs 22+)
446 (defvar replace-count) ; In `replace.el'
447 (defvar wide-n-lighter-narrow-part) ; In `wide-n.el'
448 (defvar wide-n-restrictions) ; In `wide-n.el'
449
450 ;; (< emacs-major-version 21)
451 (defvar tooltip-mode) ; In `tooltip.el'
452
453 ;; (< emacs-major-version 22)
454 (defvar compilation-current-error)
455 (defvar Info-complete-menu-buffer) ; In `info.el'
456 (defvar Info-history-list) ; In `info.el'
457 (defvar Info-menu-entry-name-re) ; In `info.el'
458 (defvar Info-read-node-completion-table) ; In `info.el'
459 (defvar list-colors-sort) ; In `facemenu.el' (Emacs 23+)
460 (defvar palette-current-color) ; In `palette.el'
461 (defvar palette-last-color) ; In `palette.el'
462 (defvar palette-mode-map) ; In `palette.el'
463 (defvar palette-popup-map) ; In `palette.el'
464 (defvar read-file-name-completion-ignore-case) ; In `minibuffer.el'
465 (defvar synonyms-append-result-flag) ; IN `synonyms.el'
466 (defvar synonyms-match-more-flag) ; In `synonyms.el'
467 (defvar synonyms-obarray) ; In `synonyms.el'
468 (defvar tags-case-fold-search) ; In `etags.el'
469
470 ;; (> emacs-major-version 21)
471 (defvar Info-saved-nodes) ; In `info+.el'
472
473 ;; (< emacs-major-version 23)
474 (defvar read-buffer-completion-ignore-case)
475
476
477 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
478
479 ;;(@* "Icicles Commands for Other Packages")
480
481 ;;; Icicles Commands for Other Packages ------------------------------
482
483 ;; Put this first
484
485 (defun icicle-cmd2-after-load-bookmark+ ()
486 "Things to do for `icicles-cmd2.el' after loading `bookmark+.el'."
487
488 (icicle-define-command icicle-bookmark-tagged ; `C-x j t j'
489 "Jump to one or more bookmarks with tags that match your input.
490 Only tagged bookmarks are candidates.
491
492 A prefix argument reverses the effect of option
493 `icicle-bookmark-refresh-cache-flag'. See the doc for that option.
494 In particular, if the option value is nil and you try to jump to a
495 bookmark that is not up to date or does not exist, then try invoking
496 the command again with a prefix arg, to refresh the cache.
497
498 Each completion candidate is a multi-completion composed of two
499 fields: the bookmark name and the bookmark tags, separated by
500 `icicle-list-join-string' \(\"^G^J\", by default). As always, you can
501 type `C-M-j' to insert this separator into the minibuffer.
502
503 For this command, by default `.' in your input matches any character,
504 including a newline. As always, you can use `C-M-.' to toggle
505 this (so `.' does not match newline).
506
507 You can match your input against the bookmark name or tags or both.
508
509 E.g., type:
510
511 `red S-TAB' to match all bookmarks with the tag `red'
512 `red S-SPC green S-SPC blue' to match all bookmarks with tags `red',
513 `green', and `blue' (in any order)
514
515 This assumes that these tags do not also match any bookmark names.
516
517 If you need to match against a particular field (e.g. the bookmark
518 name or a specific tag position), then use the field separator.
519 Otherwise, just use progressive completion, as shown above.
520
521 E.g., to match only tags and not the bookmark name, start with `C-M-j'
522 to get past the bookmark-name field. To match both bookmark name and
523 tags, type something to match the bookmark name before hitting
524 `C-M-j'. E.g., type:
525
526 `trips C-M-j red S-SPC blue' to match all bookmarks tagged `red' and
527 `blue' that have `trips' in their names
528
529 In other respects this command is like `icicle-bookmark'. See its doc
530 for more information, including about actions and keys available
531 during completion.
532
533 NOTE: You can get the same effect as this command using other
534 `icicle-bookmark*' commands, by using two multi-completion separators,
535 so that you match only bookmarks that have tags:
536
537 .* C-M-j .* C-M-j
538
539 In other words, this command is essentially just a convenience." ; Doc string
540 (lambda (cand) (icicle-bookmark-jump (icicle-transform-multi-completion cand))) ; Action
541 prompt icicle-candidates-alist ; `completing-read' args
542 nil nil nil (if (boundp 'bookmark-history) 'bookmark-history 'icicle-bookmark-history)
543 (and (boundp 'bookmark-current-bookmark) bookmark-current-bookmark) nil
544 ((enable-recursive-minibuffers t) ; In case we read input, e.g. File changed on disk...
545 (completion-ignore-case bookmark-completion-ignore-case)
546 (prompt "Bookmark `C-M-j' TAGS: ")
547 (icicle-dot-string (icicle-anychar-regexp))
548 (icicle-candidate-properties-alist '((2 (face bookmark-menu-heading))))
549 (icicle-multi-completing-p t)
550 (icicle-bookmark-completing-p t)
551 (icicle-list-use-nth-parts '(1))
552 (icicle-transform-function (and (not (interactive-p)) icicle-transform-function))
553 (icicle-whole-candidate-as-text-prop-p t)
554 (icicle-transform-before-sort-p t)
555 (icicle-candidate-help-fn (lambda (cand)
556 (setq cand (caar (funcall icicle-get-alist-candidate-function
557 cand)))
558 (if current-prefix-arg
559 (bmkp-describe-bookmark-internals cand)
560 (bmkp-describe-bookmark cand))))
561 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn 'icicle-bookmark-act-on-prop))
562 (icicle-delete-candidate-object 'icicle-bookmark-delete-action)
563 (icicle-sort-orders-alist
564 (append '(("in *Bookmark List* order") ; Renamed from "turned OFF'.
565 ("by bookmark name" . icicle-alpha-p))
566 (and (featurep 'bookmark+)
567 '(("by last bookmark access" (bmkp-bookmark-last-access-cp) icicle-alpha-p)
568 ("by bookmark visit frequency" (bmkp-visited-more-cp) icicle-alpha-p)
569 ("by last buffer or file access" (bmkp-buffer-last-access-cp
570 bmkp-local-file-accessed-more-recently-cp)
571 icicle-alpha-p)
572 ("marked before unmarked (in *Bookmark List*)" (bmkp-marked-cp)
573 icicle-alpha-p)
574 ("by local file type" (bmkp-local-file-type-cp) icicle-alpha-p)
575 ("by file name" (bmkp-file-alpha-cp) icicle-alpha-p)
576 ("by local file size" (bmkp-local-file-size-cp) icicle-alpha-p)
577 ("by last local file access" (bmkp-local-file-accessed-more-recently-cp)
578 icicle-alpha-p)
579 ("by last local file update" (bmkp-local-file-updated-more-recently-cp)
580 icicle-alpha-p)
581 ("by Info location" (bmkp-info-cp) icicle-alpha-p)
582 ("by Gnus thread" (bmkp-gnus-cp) icicle-alpha-p)
583 ("by URL" (bmkp-url-cp) icicle-alpha-p)
584 ("by bookmark type" (bmkp-info-cp bmkp-url-cp bmkp-gnus-cp
585 bmkp-local-file-type-cp bmkp-handler-cp)
586 icicle-alpha-p)))
587 '(("by previous use alphabetically" . icicle-historical-alphabetic-p)
588 ("case insensitive" . icicle-case-insensitive-string-less-p))))
589 (icicle-candidates-alist ; An alist whose items are ((BOOKMARK-NAME TAG...)).
590 (let ((result ()))
591 (bookmark-maybe-load-default-file) ; Loads bookmarks file, defining `bookmark-alist'.
592 (dolist (bmk (or (and (or (and (not icicle-bookmark-refresh-cache-flag)
593 (not (consp current-prefix-arg)))
594 (and icicle-bookmark-refresh-cache-flag (consp current-prefix-arg)))
595 bmkp-sorted-alist)
596 (setq bmkp-sorted-alist (bmkp-sort-omit bookmark-alist))))
597 (icicle-condition-case-no-debug nil ; Ignore errors, e.g. from bad or stale bookmark records.
598 (let ((tags (bmkp-get-tags bmk))
599 bname)
600 (when tags
601 (setq bname (bmkp-bookmark-name-from-record bmk))
602 (push `((,(icicle-candidate-short-help
603 (icicle-bookmark-help-string bname)
604 (icicle-bookmark-propertize-candidate bname))
605 ,@(and tags (list (format "%S" tags)))))
606 result)))
607 (error nil)))
608 result)))
609 (progn ; First code
610 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
611 (icicle-highlight-lighter)
612 (message "Gathering tagged bookmarks..."))
613 nil nil) ; Undo code, last code.
614
615 (icicle-define-command icicle-bookmark-tagged-other-window ; `C-x 4 j t j'
616 "Same as `icicle-bookmark-tagged', except uses another window." ; Doc string
617 (lambda (cand) (icicle-bookmark-jump-other-window (icicle-transform-multi-completion cand))) ; Action
618 prompt icicle-candidates-alist ; `completing-read' args
619 nil nil nil (if (boundp 'bookmark-history) 'bookmark-history 'icicle-bookmark-history)
620 (and (boundp 'bookmark-current-bookmark) bookmark-current-bookmark) nil
621 ((enable-recursive-minibuffers t) ; In case we read input, e.g. File changed on disk...
622 (completion-ignore-case bookmark-completion-ignore-case)
623 (prompt "Bookmark `C-M-j' TAGS: ")
624 (icicle-list-use-nth-parts '(1))
625 (icicle-dot-string (icicle-anychar-regexp))
626 (icicle-candidate-properties-alist '((2 (face icicle-msg-emphasis))))
627 (icicle-multi-completing-p t)
628 (icicle-bookmark-completing-p t)
629 (icicle-transform-function (and (not (interactive-p)) icicle-transform-function))
630 (icicle-whole-candidate-as-text-prop-p t)
631 (icicle-transform-before-sort-p t)
632 (icicle-candidate-help-fn (lambda (cand)
633 (setq cand (caar (funcall icicle-get-alist-candidate-function
634 cand)))
635 (if current-prefix-arg
636 (bmkp-describe-bookmark-internals cand)
637 (bmkp-describe-bookmark cand))))
638 (icicle-candidate-alt-action-fn (or icicle-candidate-alt-action-fn 'icicle-bookmark-act-on-prop))
639 (icicle-delete-candidate-object 'icicle-bookmark-delete-action)
640 (icicle-sort-orders-alist
641 (append '(("in *Bookmark List* order") ; Renamed from "turned OFF'.
642 ("by bookmark name" . icicle-alpha-p))
643 (and (featurep 'bookmark+)
644 '(("by last bookmark access" (bmkp-bookmark-last-access-cp) icicle-alpha-p)
645 ("by bookmark visit frequency" (bmkp-visited-more-cp) icicle-alpha-p)
646 ("by last buffer or file access" (bmkp-buffer-last-access-cp
647 bmkp-local-file-accessed-more-recently-cp)
648 icicle-alpha-p)
649 ("marked before unmarked (in *Bookmark List*)" (bmkp-marked-cp)
650 icicle-alpha-p)
651 ("by local file type" (bmkp-local-file-type-cp) icicle-alpha-p)
652 ("by file name" (bmkp-file-alpha-cp) icicle-alpha-p)
653 ("by local file size" (bmkp-local-file-size-cp) icicle-alpha-p)
654 ("by last local file access" (bmkp-local-file-accessed-more-recently-cp)
655 icicle-alpha-p)
656 ("by last local file update" (bmkp-local-file-updated-more-recently-cp)
657 icicle-alpha-p)
658 ("by Info location" (bmkp-info-cp) icicle-alpha-p)
659 ("by Gnus thread" (bmkp-gnus-cp) icicle-alpha-p)
660 ("by URL" (bmkp-url-cp) icicle-alpha-p)
661 ("by bookmark type" (bmkp-info-cp bmkp-url-cp bmkp-gnus-cp
662 bmkp-local-file-type-cp bmkp-handler-cp)
663 icicle-alpha-p)))
664 '(("by previous use alphabetically" . icicle-historical-alphabetic-p)
665 ("case insensitive" . icicle-case-insensitive-string-less-p))))
666 (icicle-candidates-alist ; An alist whose items are ((BOOKMARK-NAME TAG...)).
667 (let ((result ()))
668 (bookmark-maybe-load-default-file) ; Loads bookmarks file, defining `bookmark-alist'.
669 (dolist (bmk (or (and (or (and (not icicle-bookmark-refresh-cache-flag)
670 (not (consp current-prefix-arg)))
671 (and icicle-bookmark-refresh-cache-flag (consp current-prefix-arg)))
672 bmkp-sorted-alist)
673 (setq bmkp-sorted-alist (bmkp-sort-omit bookmark-alist))))
674 (icicle-condition-case-no-debug nil ; Ignore errors, e.g. from bad or stale bookmark records.
675 (let ((tags (bmkp-get-tags bmk))
676 bname)
677 (when tags
678 (setq bname (bmkp-bookmark-name-from-record bmk))
679 (push `((,(icicle-candidate-short-help
680 (icicle-bookmark-help-string bname)
681 (icicle-bookmark-propertize-candidate bname))
682 ,@(and tags (list (format "%S" tags)))))
683 result)))
684 (error nil)))
685 result)))
686 (progn ; First code
687 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
688 (icicle-highlight-lighter)
689 (message "Gathering tagged bookmarks..."))
690 nil nil) ; Undo code, last code.
691
692 (icicle-define-file-command icicle-bookmark-a-file ; `C-x p c a'
693 "Bookmark a file (create an autofile bookmark).
694 \(You need library `Bookmark+' for this command.)
695 When prompted for the file you can use `M-n' to pick up the file name
696 at point, or if none then the visited file.
697 The autofile bookmark created has the same name as the file.
698
699 During completion (`*' means this requires library `Bookmark+')\\<minibuffer-local-completion-map>, you
700 can use the following keys:
701 C-c C-d - change the `default-directory' (a la `cd')
702 C-c + - create a new directory
703 C-backspace - go up one directory level
704 \\[icicle-all-candidates-list-alt-action] - open Dired on the currently matching file names
705 \\[icicle-delete-candidate-object] - delete candidate file or (empty) dir
706 * C-x C-t * - narrow to files with all of the tags you specify
707 * C-x C-t + - narrow to files with some of the tags you specify
708 * C-x C-t % * - narrow to files with all tags matching a regexp
709 * C-x C-t % + - narrow to files with some tags matching a regexp
710 * C-x a + - add tags to current candidate
711 * C-x a - - remove tags from current candidate
712 * C-x m - access file bookmarks (not just autofiles)"
713 (lambda (file) (bmkp-bookmark-a-file file nil nil nil 'MSG))
714 "File to bookmark (autofile): " nil nil nil nil nil ; `read-file-name' args
715 (icicle-file-bindings ; Bindings
716 ((icicle-use-candidates-only-once-flag t)
717 ;; This binding is for `icicle-autofile-action', in `icicle-bind-file-candidate-keys'.
718 (icicle-full-cand-fn #'icicle-make-bookmark-candidate)
719 (icicle-all-candidates-list-alt-action-fn ; `M-|'
720 (lambda (files) (let ((enable-recursive-minibuffers t))
721 (dired-other-window (cons (read-string "Dired buffer name: ") files)))))))
722 (icicle-bind-file-candidate-keys) ; First code
723 nil ; Undo code
724 (icicle-unbind-file-candidate-keys)) ; Last code
725
726 (icicle-define-file-command icicle-tag-a-file ; `C-x p t + a'
727 "Tag a file (an autofile bookmark) with one or more tags.
728 You are prompted for the tags, then the file name.
729 Hit `RET' to enter each tag, then hit `RET' again after the last tag.
730 You can use completion to enter each tag. Completion is lax: you are
731 not limited to existing tags.
732
733 When prompted for the file you can use `M-n' to pick up the file name
734 at point, or if none then the visited file.
735
736 The tags are added to an autofile bookmark for the same file name and
737 directory. If the bookmark does not yet exist it is created.
738 Candidate help shows information about the file's autofile bookmark if
739 it already exists, or the file itself if not."
740 (lambda (file) (bmkp-autofile-add-tags file tags nil nil nil 'MSG))
741 "File to tag: " nil nil nil nil nil ; `read-file-name' args
742 (icicle-file-bindings ; Bindings
743 ((tags (bmkp-read-tags-completing))
744 (icicle-use-candidates-only-once-flag t))))
745
746 (icicle-define-file-command icicle-untag-a-file ; `C-x p t - a'
747 "Remove one or more tags from a file (an autofile bookmark).
748 You are prompted for the tags, then the file name.
749 Hit `RET' to enter each tag, then hit `RET' again after the last tag.
750 You can use completion to enter each tag. Completion is lax: you are
751 not limited to existing tags.
752
753 When prompted for the file you can use `M-n' to pick up the file name
754 at point, or if none then the visited file.
755
756 The tags are removed from an autofile bookmark for the same file name
757 and directory. During file-name completion, only files tagged with
758 all of the given input tags are completion candidates."
759 (lambda (file) (bmkp-autofile-remove-tags file tags nil nil nil 'MSG))
760 "File to untag: " nil nil t nil (and icompletep pred) ; `read-file-name' args
761 (icicle-file-bindings ; Bindings
762 ((tags (bmkp-read-tags-completing)) ; Pre bindings
763 (icicle-use-candidates-only-once-flag t))
764 ((pred (lambda (ff) ; Post bindings
765 ;; Expand relative file name, using dir from minibuffer.
766 (setq ff (expand-file-name
767 ff (icicle-file-name-directory-w-default
768 (icicle-input-from-minibuffer))))
769 (let* ((bmk (bmkp-get-autofile-bookmark ff))
770 (btgs (and bmk (bmkp-get-tags bmk))))
771 (and btgs (catch 'icicle-untag-a-file
772 (dolist (tag tags)
773 (unless (member tag btgs)
774 (throw 'icicle-untag-a-file nil)))
775 t)))))
776 (icompletep (and (featurep 'icomplete) icomplete-mode))
777 (icicle-must-pass-after-match-predicate (and (not icompletep) pred)))))
778
779 ;;$$$ Do not bother with autofiles that have a PREFIX.
780 (icicle-define-command icicle-find-file-tagged ; `C-x j t C-f C-f'.
781 "Find one or more files with tags that match your input.
782 By default, only tagged files are candidates. With a prefix argument,
783 all autofiles are candidates. (Autofiles are autofile bookmarks - you
784 need library `Bookmark+' for this command.)
785
786 Each completion candidate is a multi-completion composed of these
787 fields: an absolute file name plus the file's tags, all separated by
788 `icicle-list-join-string' (\"^G^J\", by default). As always, you can
789 type `C-M-j' to insert this separator into the minibuffer.
790
791 For this command, by default `.' in your input matches any character,
792 including a newline. As always, you can use `C-M-.' to toggle
793 this (so `.' does not match newline).
794
795 You can match your input against the file name or tags or both.
796
797 E.g., type:
798
799 `red S-TAB' to match all files with the tag `red'
800 `red S-SPC green S-SPC blue' to match all files with tags `red',
801 `green', and `blue' (in any order)
802
803 That assumes that these tags do not also match any file names.
804
805 If you need to match against a particular field (e.g. the file name or
806 a specific tag position), then use the field separator. Otherwise,
807 just use progressive completion, as shown above.
808
809 E.g., to match only tags and not the filename, start with `C-M-j' to
810 get past the file-name field. To match both file name and tags, type
811 something to match the file name before the `C-M-j'. E.g., type:
812
813 `2011 C-M-j red S-SPC blue' to match all files tagged `red' and
814 `blue' that have `2011' in their names
815
816 During completion (`*' means this requires library `Bookmark+')\\<minibuffer-local-completion-map>, you
817 can use the following keys:
818 C-c C-d - change the `default-directory' (a la `cd')
819 C-c + - create a new directory
820 C-backspace - go up one directory level
821 \\[icicle-all-candidates-list-alt-action] - open Dired on the currently matching file names
822 \\[icicle-delete-candidate-object] - delete candidate file or (empty) dir
823 * C-x C-t * - narrow to files with all of the tags you specify
824 * C-x C-t + - narrow to files with some of the tags you specify
825 * C-x C-t % * - narrow to files with all tags matching a regexp
826 * C-x C-t % + - narrow to files with some tags matching a regexp
827 * C-x a + - add tags to current candidate
828 * C-x a - - remove tags from current candidate
829 * C-x m - access file bookmarks (not just autofiles)" ; Doc string
830 (lambda (f) (bmkp-find-file (icicle-transform-multi-completion f) 'WILDCARDS)) ; Action function
831 prompt icicle-abs-file-candidates ; `completing-read' args
832 nil nil nil 'icicle-filetags-history nil nil
833 (icicle-file-bindings ; Pre bindings
834 ((prompt "FILE `C-M-j' TAGS: ")
835 ;; This binding is for `icicle-autofile-action', in `icicle-bind-file-candidate-keys'.
836 (icicle-full-cand-fn (lambda (file)
837 (list (cons file (bmkp-get-tags
838 (bmkp-get-autofile-bookmark file))))))
839 (icicle-abs-file-candidates ; An alist whose items are ((FILE TAG...)).
840 (let ((result ()))
841 (dolist (autofile (bmkp-autofile-alist-only))
842 (let ((tags (bmkp-get-tags autofile)))
843 (when (or tags current-prefix-arg)
844 (push (list (cons (bookmark-get-filename autofile) tags)) result))))
845 result))
846 (icicle-dot-string (icicle-anychar-regexp))
847 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
848 (icicle-multi-completing-p t)
849 (icicle-list-use-nth-parts '(1))
850 (icicle-whole-candidate-as-text-prop-p t))
851 ((icicle-candidate-help-fn (lambda (cand) ; Post bindings
852 (setq cand (icicle-transform-multi-completion cand))
853 (icicle-describe-file cand
854 current-prefix-arg
855 t)))))
856 (progn ; First code
857 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
858 (icicle-highlight-lighter)
859 (message "Gathering tagged files...")
860 (icicle-bind-file-candidate-keys))
861 nil ; Undo code
862 (icicle-unbind-file-candidate-keys)) ; Last code
863
864 (icicle-define-command icicle-find-file-tagged-other-window ; `C-x 4 j t C-f C-f'
865 "Same as `icicle-find-file-tagged', except uses another window." ; Doc string
866 (lambda (f) (bmkp-find-file-other-window (icicle-transform-multi-completion f) 'WILDCARDS)) ; Action
867 prompt icicle-abs-file-candidates ; `completing-read' args
868 nil nil nil 'icicle-filetags-history nil nil
869 (icicle-file-bindings ; Pre bindings
870 ((prompt "FILE `C-M-j' TAGS: ")
871 ;; This binding is for `icicle-autofile-action', in `icicle-bind-file-candidate-keys'.
872 (icicle-full-cand-fn (lambda (file)
873 (list (cons file (bmkp-get-tags
874 (bmkp-get-autofile-bookmark file))))))
875 (icicle-abs-file-candidates ; An alist whose items are ((FILE TAG...)).
876 (let ((result ()))
877 (dolist (autofile (bmkp-autofile-alist-only))
878 (let ((tags (bmkp-get-tags autofile)))
879 (when (or tags current-prefix-arg)
880 (push (list (cons (bookmark-get-filename autofile) tags)) result))))
881 result))
882 (icicle-dot-string (icicle-anychar-regexp))
883 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
884 (icicle-multi-completing-p t)
885 (icicle-list-use-nth-parts '(1))
886 (icicle-whole-candidate-as-text-prop-p t))
887 ((icicle-candidate-help-fn (lambda (cand) ; Post bindings
888 (setq cand (icicle-transform-multi-completion cand))
889 (icicle-describe-file cand current-prefix-arg t)))))
890 (progn ; First code
891 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
892 (icicle-highlight-lighter)
893 (message "Gathering tagged files...")
894 (icicle-bind-file-candidate-keys))
895 nil ; Undo code
896 (icicle-unbind-file-candidate-keys)) ; Last code
897
898 (icicle-define-file-command icicle-find-file-handle-bookmark ; `C-x j C-f'
899 "Visit a file or directory, respecting any associated autofile handlers.
900 This is similar to `icicle-find-file', But the file is accessed using
901 `bmkp-find-file', which means that if it has an associated handler in
902 `bmkp-default-handlers-for-file-types' then that handler is used to
903 visit the file.
904
905 If you use a prefix arg when acting on a completion candidate then an
906 autofile bookmark is created for the file, unless it already has one.
907
908 When prompted for the file name you can use `M-n' to pick up the file
909 name at point, or if none then the visited file."
910 bmkp-find-file
911 "Find file: " nil nil t nil nil ; `read-file-name' args
912 (icicle-file-bindings ; Bindings
913 ((init-pref-arg current-prefix-arg) ; Pre bindings
914 (icicle-all-candidates-list-alt-action-fn ; `M-|'
915 (lambda (files) (let ((enable-recursive-minibuffers t))
916 (dired-other-window (cons (read-string "Dired buffer name: ") files)))))))
917 (icicle-bind-file-candidate-keys) ; First code.
918 nil ; Undo code.
919 (icicle-unbind-file-candidate-keys)) ; Last code.
920
921 (icicle-define-file-command icicle-find-file-handle-bookmark-other-window ; `C-x 4 j C-f'
922 "Same as `icicle-find-file-handle-bookmark', except uses another window."
923 bmkp-find-file-other-window
924 "Find file: " nil nil t nil nil ; `read-file-name' args
925 (icicle-file-bindings ; Bindings
926 ((init-pref-arg current-prefix-arg) ; Pre bindings
927 (icicle-all-candidates-list-alt-action-fn ; `M-|'
928 (lambda (files) (let ((enable-recursive-minibuffers t))
929 (dired-other-window (cons (read-string "Dired buffer name: ") files)))))))
930 (icicle-bind-file-candidate-keys) ; First code.
931 nil ; Undo code.
932 (icicle-unbind-file-candidate-keys)) ; Last code.
933
934 (icicle-define-file-command icicle-find-file-all-tags ; `C-x j t C-f *'
935 "Visit a file or directory that has all of the tags you enter.
936 Only tagged autofiles are candidates.
937
938 This is essentially a multi-command versions of `bmkp-find-file-all-tags'.
939
940 You are prompted first for the tags. Hit `RET' to enter each tag,
941 then hit `RET' again after the last tag. You can use completion to
942 enter each tag. This completion is lax: you are not limited to
943 existing tags.
944
945 By default, the tag choices for completion are NOT refreshed, to save
946 time. Use a prefix argument if you want to refresh them.
947
948 You are then prompted for the file name. This is read using
949 `read-file-name', so you can browse up and down the file hierarchy.
950 \(The completion candidates are file names, not bookmark names.)
951
952 If you specify no tags, then every file that has some tags is a
953 candidate.
954
955 When prompted for the file you can use `M-n' to pick up the file name
956 at point, or if none then the visited file."
957 (lambda (file) (bmkp-find-file file 'MUST-EXIST)) ; Function to perform the action
958 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
959 (icicle-file-bindings ; Bindings
960 ((tags (bmkp-read-tags-completing ; Pre bindings
961 nil nil current-prefix-arg))
962 (icicle-all-candidates-list-alt-action-fn ; `M-|'
963 (lambda (files) (let ((enable-recursive-minibuffers t))
964 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
965 ((pred `(lambda (ff) ; Post bindings
966 (let* ((bmk (bmkp-get-autofile-bookmark ff))
967 (btgs (and bmk (bmkp-get-tags bmk))))
968 (and btgs (bmkp-every `(lambda (tag)
969 (bmkp-has-tag-p ',bmk tag))
970 ',tags)))))
971 (icompletep (and (featurep 'icomplete) icomplete-mode))
972 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
973 (icicle-bind-file-candidate-keys) ; First code.
974 nil ; Undo code.
975 (icicle-unbind-file-candidate-keys)) ; Last code.
976
977 (icicle-define-file-command icicle-find-file-all-tags-other-window ; `C-x 4 j t C-f *'
978 "Same as `icicle-find-file-all-tags', except uses another window."
979 (lambda (file) (bmkp-find-file-other-window file 'MUST-EXIST)) ; Function to perform the action
980 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
981 (icicle-file-bindings ; Bindings
982 ((tags (bmkp-read-tags-completing ; Pre bindings
983 nil nil current-prefix-arg))
984 (icicle-all-candidates-list-alt-action-fn ; `M-|'
985 (lambda (files) (let ((enable-recursive-minibuffers t))
986 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
987 ((pred `(lambda (ff) ; Post bindings
988 (let* ((bmk (bmkp-get-autofile-bookmark ff))
989 (btgs (and bmk (bmkp-get-tags bmk))))
990 (and btgs (bmkp-every `(lambda (tag)
991 (bmkp-has-tag-p ',bmk tag))
992 ',tags)))))
993 (icompletep (and (featurep 'icomplete) icomplete-mode))
994 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
995 (icicle-bind-file-candidate-keys) ; First code.
996 nil ; Undo code.
997 (icicle-unbind-file-candidate-keys)) ; Last code.
998
999 (icicle-define-file-command icicle-find-file-all-tags-regexp ; `C-x j t C-f % *'
1000 "Visit a file or directory that has each tag matching a regexp you enter.
1001 When prompted for the file you can use `M-n' to pick up the file name
1002 at point, or if none then the visited file."
1003 (lambda (file) (bmkp-find-file file 'MUST-EXIST)) ; Function to perform the action
1004 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
1005 (icicle-file-bindings ; Bindings
1006 ((regexp (icicle-read-regexp "Regexp for tags: ")) ; Pre bindings
1007 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1008 (lambda (files) (let ((enable-recursive-minibuffers t))
1009 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
1010 ((pred (lambda (ff) ; Post bindings
1011 (let* ((bmk (bmkp-get-autofile-bookmark ff))
1012 (btgs (and bmk (bmkp-get-tags bmk))))
1013 (and btgs (bmkp-every `(lambda (tag)
1014 (string-match
1015 ',regexp (bmkp-tag-name tag)))
1016 btgs)))))
1017 (icompletep (and (featurep 'icomplete) icomplete-mode))
1018 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
1019 (icicle-bind-file-candidate-keys) ; First code.
1020 nil ; Undo code.
1021 (icicle-unbind-file-candidate-keys)) ; Last code.
1022
1023 (icicle-define-file-command icicle-find-file-all-tags-regexp-other-window ; `C-x 4 j t C-f % *'
1024 "Same as `icicle-find-file-all-tags-regexp', except uses another window."
1025 (lambda (file) (bmkp-find-file-other-window file 'MUST-EXIST)) ; Function to perform the action
1026 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
1027 (icicle-file-bindings ; Bindings
1028 ((regexp (icicle-read-regexp "Regexp for tags: ")) ; Pre bindings
1029 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1030 (lambda (files) (let ((enable-recursive-minibuffers t))
1031 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
1032 ((pred (lambda (ff) ; Post bindings
1033 (let* ((bmk (bmkp-get-autofile-bookmark ff))
1034 (btgs (and bmk (bmkp-get-tags bmk))))
1035 (and btgs (bmkp-every `(lambda (tag)
1036 (string-match
1037 ',regexp (bmkp-tag-name tag)))
1038 btgs)))))
1039 (icompletep (and (featurep 'icomplete) icomplete-mode))
1040 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
1041 (icicle-bind-file-candidate-keys) ; First code.
1042 nil ; Undo code.
1043 (icicle-unbind-file-candidate-keys)) ; Last code.
1044
1045 (icicle-define-file-command icicle-find-file-some-tags ; `C-x j t C-f +'
1046 "Visit a file or directory that has at least one of the tags you enter.
1047 You are prompted for the tags, then the file name.
1048 Hit `RET' to enter each tag, then hit `RET' again after the last tag.
1049 You can use completion to enter each tag. Completion is lax: you are
1050 not limited to existing tags.
1051
1052 When prompted for the file you can use `M-n' to pick up the file name
1053 at point, or if none then the visited file."
1054 (lambda (file) (bmkp-find-file file 'MUST-EXIST)) ; Function to perform the action
1055 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
1056 (icicle-file-bindings ; Bindings
1057 ((tags (bmkp-read-tags-completing ; Pre bindings
1058 nil nil current-prefix-arg))
1059 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1060 (lambda (files) (let ((enable-recursive-minibuffers t))
1061 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
1062 ((pred `(lambda (ff) ; Post bindings
1063 (let* ((bmk (bmkp-get-autofile-bookmark ff))
1064 (btgs (and bmk (bmkp-get-tags bmk))))
1065 (and btgs (bmkp-some `(lambda (tag)
1066 (bmkp-has-tag-p ',bmk tag))
1067 ',tags)))))
1068 (icompletep (and (featurep 'icomplete) icomplete-mode))
1069 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
1070 (icicle-bind-file-candidate-keys) ; First code.
1071 nil ; Undo code.
1072 (icicle-unbind-file-candidate-keys)) ; Last code.
1073
1074 (icicle-define-file-command icicle-find-file-some-tags-other-window ; `C-x 4 j t C-f +'
1075 "Same as `icicle-find-file-some-tags', except uses another window."
1076 (lambda (file) (bmkp-find-file-other-window file 'MUST-EXIST)) ; Function to perform the action
1077 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
1078 (icicle-file-bindings ; Bindings
1079 ((tags (bmkp-read-tags-completing ; Pre bindings
1080 nil nil current-prefix-arg))
1081 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1082 (lambda (files) (let ((enable-recursive-minibuffers t))
1083 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
1084 ((pred `(lambda (ff) ; Post bindings
1085 (let* ((bmk (bmkp-get-autofile-bookmark ff))
1086 (btgs (and bmk (bmkp-get-tags bmk))))
1087 (and btgs (bmkp-some `(lambda (tag)
1088 (bmkp-has-tag-p ',bmk tag))
1089 ',tags)))))
1090 (icompletep (and (featurep 'icomplete) icomplete-mode))
1091 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
1092 (icicle-bind-file-candidate-keys) ; First code.
1093 nil ; Undo code.
1094 (icicle-unbind-file-candidate-keys)) ; Last code.
1095
1096 (icicle-define-file-command icicle-find-file-some-tags-regexp ; `C-x j t C-f % +'
1097 "Visit a file or directory that has a tag matching a regexp you enter.
1098 When prompted for the file you can use `M-n' to pick up the file name
1099 at point, or if none then the visited file."
1100 (lambda (file) (bmkp-find-file-other-window file 'MUST-EXIST)) ; Function to perform the action
1101 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
1102 (icicle-file-bindings ; Bindings
1103 ((regexp (icicle-read-regexp "Regexp for tags: ")) ; Pre bindings
1104 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1105 (lambda (files) (let ((enable-recursive-minibuffers t))
1106 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
1107 ((pred (lambda (ff) ; Post bindings
1108 (let* ((bmk (bmkp-get-autofile-bookmark ff))
1109 (btgs (and bmk (bmkp-get-tags bmk))))
1110 (and btgs (bmkp-some
1111 `(lambda (tag)
1112 (string-match ',regexp (bmkp-tag-name tag)))
1113 btgs)))))
1114 (icompletep (and (featurep 'icomplete) icomplete-mode))
1115 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
1116 (icicle-bind-file-candidate-keys) ; First code.
1117 nil ; Undo code.
1118 (icicle-unbind-file-candidate-keys)) ; Last code.
1119
1120 (icicle-define-file-command icicle-find-file-some-tags-regexp-other-window ; `C-x 4 j t C-f % +'
1121 "Same as `icicle-find-file-some-tags-regexp', except uses another window."
1122 (lambda (file) (bmkp-find-file-other-window file 'MUST-EXIST)) ; Function to perform the action
1123 "Find file: " nil nil t nil (and icompletep pred) ; `read-file-name' args
1124 (icicle-file-bindings ; Bindings
1125 ((regexp (icicle-read-regexp "Regexp for tags: ")) ; Pre bindings
1126 (icicle-all-candidates-list-alt-action-fn ; `M-|'
1127 (lambda (files) (let ((enable-recursive-minibuffers t))
1128 (dired-other-window (cons (read-string "Dired buffer name: ") files))))))
1129 ((pred (lambda (ff) ; Post bindings
1130 (let* ((bmk (bmkp-get-autofile-bookmark ff))
1131 (btgs (and bmk (bmkp-get-tags bmk))))
1132 (and btgs (bmkp-some
1133 `(lambda (tag)
1134 (string-match ',regexp (bmkp-tag-name tag)))
1135 btgs)))))
1136 (icompletep (and (featurep 'icomplete) icomplete-mode))
1137 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))))
1138 (icicle-bind-file-candidate-keys) ; First code.
1139 nil ; Undo code.
1140 (icicle-unbind-file-candidate-keys)) ; Last code.
1141 )
1142
1143
1144 (defun icicle-cmd2-after-load-hexrgb ()
1145 "Things to do for `icicles-cmd2.el' after loading `hexrgb.el'."
1146
1147 (defvar icicle-named-colors ()
1148 "Named colors.")
1149
1150 (when (and (fboundp 'read-color) (not (fboundp 'icicle-ORIG-read-color))) ; Exists with Emacs 23+.
1151 (fset 'icicle-ORIG-read-color (symbol-function 'read-color))) ; Not used, but save it anyway.
1152
1153 (defun icicle-color-from-multi-completion-input (raw-input msgp)
1154 "Get color from user RAW-INPUT for color multi-completion candidates.
1155 The arguments are the same as for `icicle-read-color-WYSIWYG'."
1156 (let ((mouse-pseudo-color-p nil)
1157 color)
1158 (when (string= "" raw-input) (icicle-user-error "No such color: %S" raw-input))
1159 (cond ((string-match "\\`'.+': " raw-input)
1160 (let ((icicle-list-nth-parts-join-string ": ")
1161 (icicle-list-join-string ": ")
1162 (icicle-list-use-nth-parts '(2)))
1163 (setq color (icicle-transform-multi-completion raw-input))))
1164 ((fboundp 'eyedrop-foreground-at-point)
1165 (cond ((string-match "^\*mouse-2 foreground\*" raw-input)
1166 (setq color (prog1 (eyedrop-foreground-at-mouse
1167 (read-event
1168 "Click `mouse-2' anywhere to choose foreground color"))
1169 (read-event)) ; Discard mouse up event.
1170 mouse-pseudo-color-p t))
1171 ((string-match "^\*mouse-2 background\*" raw-input)
1172 (setq color (prog1 (eyedrop-background-at-mouse
1173 (read-event
1174 "Click `mouse-2' anywhere to choose background color"))
1175 (read-event)) ; Discard mouse up event.
1176 mouse-pseudo-color-p t)))
1177 (setq color (icicle-transform-multi-completion
1178 (if mouse-pseudo-color-p
1179 (concat color ": " (hexrgb-color-name-to-hex color))
1180 raw-input)))))
1181
1182 ;; If the user did not complete but just entered a color name, then transformation can return "".
1183 ;; In that case, get the color just read from the input history, and transform that.
1184 (when (string= "" color) ; This "" resulted from `icicle-transform-multi-completion', above.
1185 (let ((col (car-safe (symbol-value minibuffer-history-variable))))
1186 (setq color (cond ((equal '(1) icicle-list-use-nth-parts) col) ; Cannot do more.
1187 ((equal '(2) icicle-list-use-nth-parts) (hexrgb-color-name-to-hex col))
1188 (t (let ((icicle-list-nth-parts-join-string ": ")
1189 (icicle-list-join-string ": "))
1190 (icicle-transform-multi-completion color)))))))
1191 (when msgp (message "Color: `%s'" (icicle-propertize color 'face 'icicle-msg-emphasis)))
1192 color))
1193
1194 ;; See also `hexrgb-read-color' in `hexrgb.el'.
1195 (defun icicle-read-color (&optional prompt convert-to-RGB-p allow-empty-name-p msgp)
1196 "Read a color name or RGB hexadecimal triplet.
1197 Return the name or the RGB hex string for the chosen color.
1198
1199 By default (see option `icicle-functions-to-redefine'), this is used
1200 in place of standard command `read-color' when you are in Icicle mode,
1201 so that any existing code that calls that command invokes this one
1202 instead.
1203
1204 `icicle-read-color' has the advantage of being an Icicles
1205 multi-command that provides WYSIWYG completion, color-variable proxy
1206 candidates, alternate candidate actions, candidate help, and multiple
1207 color-related candidate sort orders.
1208
1209 In this it is like command `icicle-read-color-WYSIWYG', but it is less
1210 powerful and generally less flexible than `icicle-read-color-WYSIWYG'.
1211 Another difference is that `icicle-read-color-WYSIWYG' always raises
1212 an error for empty input, unless you wrap it in `ignore-errors'.
1213
1214
1215 In Lisp code that you write, and for interactive use,
1216 `icicle-read-color-WYSIWYG' is generally a better choice than
1217 `icicle-read-color'.
1218
1219 Optional argument PROMPT is a non-default prompt to use.
1220
1221 Interactively, or if CONVERT-TO-RGB-P is non-nil, return the RGB hex
1222 string for the chosen color. If nil, return the color name.
1223
1224 Optional arg ALLOW-EMPTY-NAME-P controls what happens if you enter an
1225 empty color name (that is, you just hit `RET'). If non-nil, then
1226 `icicle-read-color' returns an empty color name, \"\". If nil, then
1227 it raises an error. Calling programs must test for \"\" if
1228 ALLOW-EMPTY-NAME-P is non-nil. They can then perform an appropriate
1229 action in case of empty input.
1230
1231 Interactively, or with non-nil MSGP, show chosen color in echo area."
1232 (interactive "i\np\ni\np") ; Always convert to RGB interactively.
1233 (let ((color (condition-case nil (icicle-read-color-WYSIWYG (if convert-to-RGB-p 2 1) prompt) (error ""))))
1234 (when (and (not allow-empty-name-p) (string= "" color)) (icicle-user-error "No such color: %S" color))
1235 (when msgp (message "Color: `%s'" (icicle-propertize color 'face 'icicle-msg-emphasis)))
1236 color))
1237
1238 (defun icicle-read-color-WYSIWYG (&optional arg prompt initial-input msgp)
1239 "Read a color name or hex RGB color value #RRRRGGGGBBBB.
1240 Return a string value.
1241 Interactively, optional argument ARG is the prefix arg - see below.
1242 Optional argument PROMPT is a non-default prompt to use.
1243 Optional argument INITIAL-INPUT is a initial input to insert in the
1244 minibuffer for completion. It is passed to `completing-read'.
1245 Interactively, or with non-nil MSGP, show chosen color in echo area.
1246
1247 In addition to standard color names and RGB (red, green, blue) hex
1248 values, the following are also available as proxy color candidates,
1249 provided `icicle-add-proxy-candidates-flag' is non-nil and library
1250 `palette.el' or `eyedropper.el' is used. In each case, the
1251 corresponding color is used.
1252
1253 * `*copied foreground*' - last copied foreground, if available
1254 * `*copied background*' - last copied background, if available
1255 * `*mouse-2 foreground*' - foreground where you click `mouse-2'
1256 * `*mouse-2 background*' - background where you click `mouse-2'
1257 * `*point foreground*' - foreground under the text cursor
1258 * `*point background*' - background under the text cursor
1259
1260 \(You can copy a color using eyedropper commands such as
1261 `eyedrop-pick-foreground-at-mouse'.)
1262
1263 In addition, the names of user options (variables) whose custom type
1264 is `color' are also proxy candidates, but with `'' as a prefix and
1265 suffix. So, for example, option `icicle-region-background' appears as
1266 proxy color candidate `'icicle-region-background''. If you choose
1267 such a candidate then (only) the variable's value is returned.
1268
1269 As always, you can toggle the use of proxy candidates using `\\<minibuffer-local-completion-map>\
1270 \\[icicle-toggle-proxy-candidates]' in
1271 the minibuffer.
1272
1273 With plain `C-u', use `hexrgb-read-color', which lets you complete a
1274 color name or input any valid RGB hex value (without completion).
1275
1276 With no prefix arg, return a string with both the color name and the
1277 RGB value, separated by `icicle-list-nth-parts-join-string'.
1278
1279 With a numeric prefix arg of 0 or 1, return the color name.
1280 With any other numeric prefix arg, return the RGB hex triplet.
1281
1282 In the plain `C-u' case, your input is checked to ensure that it
1283 represents a valid color.
1284
1285 An error is raised if you enter empty input. (In Lisp code, if you
1286 want to allow a return value of \"\" then wrap the call in
1287 `ignore-errors'.)
1288
1289 In all other cases:
1290
1291 - You can complete your input against the color name, the RGB value,
1292 or both.
1293
1294 - If you enter input without completing or cycling, the input is not
1295 checked: whatever is entered is returned as the string value.
1296
1297 You can, as usual in Icicles, use \\<minibuffer-local-completion-map>`\\[icicle-change-sort-order]' \
1298 to cycle among various sort
1299 orders. There is a rich variety of orders, including HSV and RGB
1300 distance from a color you specify.
1301
1302 From Emacs Lisp, ARG controls what is returned. If ARG is nil,
1303 `icicle-list-use-nth-parts' can also be used to control the behavior.
1304
1305 Note: Duplicate color names are removed by downcasing and removing
1306 whitespace. For example, \"AliceBlue\" and \"alice blue\" are both
1307 treated as \"aliceblue\". Otherwise, candidates with different names
1308 but the same RGB values are not considered duplicates, so, for
1309 example, input can match either \"darkred\" or \"red4\", which both
1310 have RGB #8b8b00000000. You can toggle duplicate removal at any time
1311 using `\\[icicle-toggle-transforming]'.
1312
1313 During completion, candidate help (e.g. `\\[icicle-help-on-candidate]') shows you the RGB
1314 and HSV (hue, saturation, value) color components.
1315
1316 This command is intended only for use in Icicle mode (but it can be
1317 used with `C-u', with Icicle mode turned off)."
1318 (interactive "P\ni\ni\np")
1319 (unless (featurep 'hexrgb) (icicle-user-error "You need library `hexrgb.el' for this command"))
1320 (let ((icicle-color-completing-p t)
1321 raw-input)
1322 (if (consp arg) ; Plain `C-u': complete against color name only, and be able to
1323 (hexrgb-read-color nil 'CONVERT-TO-RGB) ; input any valid RGB string.
1324
1325 ;; Complete against name+RGB pairs, but user can enter invalid value without completing.
1326 (when arg (setq arg (prefix-numeric-value arg))) ; Convert `-' to -1.
1327 (let ((icicle-multi-completing-p t)
1328 (icicle-list-use-nth-parts
1329 (or (and arg (if (< arg 2) '(1) '(2))) ; 1 or 2, either by program or via `C-1' or `C-2'.
1330 icicle-list-use-nth-parts ; Bound externally by program.
1331 '(1 2))) ; Both parts, by default.
1332 icicle-candidate-help-fn completion-ignore-case
1333 icicle-transform-function icicle-sort-orders-alist
1334 icicle-list-nth-parts-join-string icicle-list-join-string
1335 icicle-proxy-candidate-regexp icicle-named-colors
1336 icicle-proxy-candidates)
1337 ;; Copy the prompt string because `icicle-color-completion-setup' puts a text prop on it.
1338 ;; Use `icicle-prompt' from now on, since that's what `icicle-color-completion-setup'
1339 ;; sets up.
1340 (setq icicle-prompt (copy-sequence (or prompt "Color (name or #RGB triplet): ")))
1341 (icicle-color-completion-setup)
1342 (setq icicle-proxy-candidates
1343 (append icicle-proxy-candidates
1344 (mapcar ; Convert multi-completions to strings.
1345 (lambda (entry) (mapconcat #'identity (car entry) icicle-list-join-string))
1346 '((("*mouse-2 foreground*")) (("*mouse-2 background*")))))
1347 raw-input (let ((icicle-orig-window (selected-window))
1348 (icicle-candidate-alt-action-fn
1349 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "color")))
1350 (icicle-all-candidates-list-alt-action-fn
1351 (or icicle-all-candidates-list-alt-action-fn
1352 (icicle-alt-act-fn-for-type "color"))))
1353 (completing-read icicle-prompt icicle-named-colors nil nil initial-input)))
1354 (icicle-color-from-multi-completion-input raw-input msgp)))))
1355
1356 (icicle-define-command icicle-frame-bg ; Command name
1357 "Change background of current frame.
1358 Read color name or hex RGB color value #RRRRGGGGBBBB with completion.
1359 In addition to standard color names and RGB (red, green, blue) hex
1360 values, the following are also available as proxy color candidates,
1361 provided `icicle-add-proxy-candidates-flag' is non-nil and library
1362 `palette.el' or `eyedropper.el' is used. In each case, the
1363 corresponding color is used.
1364
1365 * `*copied foreground*' - last copied foreground, if available
1366 * `*copied background*' - last copied background, if available
1367 * `*point foreground*' - foreground under the text cursor
1368 * `*point background*' - background under the text cursor
1369
1370 \(You can copy a color using eyedropper commands such as
1371 `eyedrop-pick-foreground-at-mouse'.)
1372
1373 In addition, the names of user options (variables) whose custom type
1374 is `color' are also proxy candidates, but with `'' as a prefix and
1375 suffix. So, for example, option `icicle-region-background' appears as
1376 proxy color candidate `'icicle-region-background''.
1377
1378 As always, you can toggle the use of proxy candidates using `\\<minibuffer-local-completion-map>\
1379 \\[icicle-toggle-proxy-candidates]' in
1380 the minibuffer.
1381
1382 You can complete your input against the color name, the RGB value, or
1383 both.
1384
1385 Note: Duplicate color names are removed by downcasing and removing
1386 whitespace. For example, \"AliceBlue\" and \"alice blue\" are both
1387 treated as \"aliceblue\". Otherwise, candidates with different names
1388 but the same RGB values are not considered duplicates, so, for
1389 example, input can match either \"darkred\" or \"red4\", which both
1390 have RGB #8b8b00000000. You can toggle duplicate removal at any time
1391 using \\<minibuffer-local-completion-map>`\\[icicle-toggle-transforming]'.
1392
1393 During completion, candidate help (e.g. `\\[icicle-help-on-candidate]') shows you the RGB
1394 and HSV (hue, saturation, value) color components.
1395
1396 After changing the background of the current frame, if you want to
1397 save it as your default background, an easy way to do that is to use
1398 command `set-frame-alist-parameter-from-frame' from library
1399 `frame-cmds.el':
1400
1401 M-x set-frame-alist-parameter-from-frame
1402
1403 You are prompted for the frame alist variable to set
1404 \(e.g. `default-frame-alist') and for the frame parameter to copy from
1405 the current frame (in this case, parameter `background-color').
1406
1407 This command is intended only for use in Icicle mode." ; Doc string
1408 (lambda (color) ; Action function
1409 (modify-frame-parameters
1410 icicle-orig-frame (list (cons 'background-color (icicle-transform-multi-completion color)))))
1411 icicle-prompt icicle-named-colors nil t nil ; `completing-read' args
1412 (if (boundp 'color-history) 'color-history 'icicle-color-history) nil nil
1413 ((icicle-orig-frame (selected-frame)) ; Bindings
1414 (orig-bg (frame-parameter nil 'background-color))
1415 (icicle-prompt "Background color: ")
1416 (icicle-multi-completing-p t)
1417 (icicle-list-use-nth-parts '(2)) ; Use RGB part.
1418 (icicle-candidate-alt-action-fn
1419 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "color")))
1420 (icicle-all-candidates-list-alt-action-fn
1421 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "color")))
1422
1423 icicle-candidate-help-fn completion-ignore-case icicle-transform-function
1424 icicle-sort-orders-alist icicle-list-nth-parts-join-string icicle-list-join-string
1425 icicle-proxy-candidate-regexp icicle-named-colors icicle-proxy-candidates)
1426 (icicle-color-completion-setup) ; First code - needs `hexrgb.el'
1427 (modify-frame-parameters icicle-orig-frame (list (cons 'background-color orig-bg))) ; Undo code
1428 nil) ; Last code
1429
1430 (icicle-define-command icicle-frame-fg ; Command name
1431 "Change foreground of current frame.
1432 See `icicle-frame-bg' - but this is for foreground, not background." ; Doc string
1433 (lambda (color) ; Action function
1434 (modify-frame-parameters
1435 icicle-orig-frame (list (cons 'foreground-color (icicle-transform-multi-completion color)))))
1436 icicle-prompt icicle-named-colors nil t nil ; `completing-read' args
1437 (if (boundp 'color-history) 'color-history 'icicle-color-history) nil nil
1438 ((icicle-orig-frame (selected-frame)) ; Bindings
1439 (orig-bg (frame-parameter nil 'foreground-color))
1440 (icicle-prompt "Foreground color: ")
1441 (icicle-multi-completing-p t)
1442 (icicle-list-use-nth-parts '(2)) ; Use RGB part.
1443 (icicle-candidate-alt-action-fn
1444 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "color")))
1445 (icicle-all-candidates-list-alt-action-fn
1446 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "color")))
1447
1448 icicle-candidate-help-fn completion-ignore-case icicle-transform-function
1449 icicle-sort-orders-alist icicle-list-nth-parts-join-string icicle-list-join-string
1450 icicle-proxy-candidate-regexp icicle-named-colors icicle-proxy-candidates)
1451 (icicle-color-completion-setup) ; First code - needs `hexrgb.el'
1452 (modify-frame-parameters icicle-orig-frame (list (cons 'foreground-color orig-bg))) ; Undo code
1453 nil) ; Last code
1454
1455 ;; Free vars here:
1456 ;; `icicle-prompt', `icicle-candidate-help-fn', `completion-ignore-case',
1457 ;; `icicle-transform-function', `icicle-sort-orders-alist', `icicle-list-nth-parts-join-string',
1458 ;; `icicle-list-join-string', `icicle-proxy-candidate-regexp', `icicle-named-colors',
1459 ;; `icicle-proxy-candidates'.
1460 (defun icicle-color-completion-setup ()
1461 "Set up for color-name/RGB-value completion (helper function).
1462 Sets these variables, which are assumed to be already `let'-bound:
1463 `icicle-prompt'
1464 `icicle-candidate-help-fn'
1465 `completion-ignore-case'
1466 `icicle-transform-function'
1467 `icicle-sort-orders-alist'
1468 `icicle-list-nth-parts-join-string'
1469 `icicle-list-join-string'
1470 `icicle-proxy-candidate-regexp'
1471 `icicle-named-colors'
1472 `icicle-proxy-candidates'
1473 Puts property `icicle-fancy-candidates' on string `icicle-prompt'."
1474 (if (< emacs-major-version 22)
1475 (require 'eyedropper nil t)
1476 (or (require 'palette nil t) (require 'eyedropper nil t)))
1477 (when (stringp icicle-prompt) ; Sanity check - should be true.
1478 (put-text-property 0 1 'icicle-fancy-candidates t icicle-prompt))
1479 (icicle-highlight-lighter)
1480 (setq icicle-candidate-help-fn 'icicle-color-help
1481 completion-ignore-case t
1482 icicle-sort-orders-alist
1483 '(("by color name" . icicle-part-1-lessp)
1484 ("by color hue" . (lambda (s1 s2) (not (icicle-color-hue-lessp s1 s2))))
1485 ("by color purity (saturation)"
1486 . (lambda (s1 s2) (not (icicle-color-saturation-lessp s1 s2))))
1487 ("by color brightness (value)"
1488 . (lambda (s1 s2) (not (icicle-color-value-lessp s1 s2))))
1489 ("by color hsv" . (lambda (s1 s2) (not (icicle-color-hsv-lessp s1 s2))))
1490 ("by hsv distance" . (lambda (s1 s2) (icicle-color-distance-hsv-lessp s1 s2)))
1491 ("by amount of red" . (lambda (s1 s2) (not (icicle-color-red-lessp s1 s2))))
1492 ("by amount of green" . (lambda (s1 s2) (not (icicle-color-green-lessp s1 s2))))
1493 ("by amount of blue" . (lambda (s1 s2) (not (icicle-color-blue-lessp s1 s2))))
1494 ("by color rgb" . (lambda (s1 s2) (not (icicle-color-rgb-lessp s1 s2))))
1495 ("by rgb distance" . (lambda (s1 s2) (icicle-color-distance-rgb-lessp s1 s2)))
1496 ("turned OFF"))
1497 ;; Make the two `*-join-string' variables the same, so past inputs are recognized.
1498 ;; Do not use " " as the value, because color names such as "white smoke" would be
1499 ;; split, and "smoke" would not be recognized as a color name when trying to list
1500 ;; candidates in `*Completions*'.
1501 icicle-list-nth-parts-join-string ": "
1502 icicle-list-join-string ": "
1503 icicle-proxy-candidate-regexp "^[*'].+[*']"
1504
1505 icicle-named-colors (mapcar #'icicle-make-color-candidate
1506 (hexrgb-defined-colors))
1507 icicle-proxy-candidates
1508 (mapcar ; Convert multi-completions to strings.
1509 (lambda (entry) (mapconcat #'identity (car entry) icicle-list-join-string))
1510 (append
1511 (and (fboundp 'eyedrop-foreground-at-point)
1512 (append (and eyedrop-picked-foreground ; Multi-completions.
1513 `(,(icicle-make-color-candidate
1514 "*copied foreground*" (downcase (hexrgb-color-name-to-hex
1515 eyedrop-picked-foreground)))))
1516 (and eyedrop-picked-background
1517 `(,(icicle-make-color-candidate
1518 "*copied background*" (downcase (hexrgb-color-name-to-hex
1519 eyedrop-picked-background)))))
1520 `(,(icicle-make-color-candidate
1521 "*point foreground*" (downcase (hexrgb-color-name-to-hex
1522 (eyedrop-foreground-at-point))))
1523 ,(icicle-make-color-candidate
1524 "*point background*" (downcase (hexrgb-color-name-to-hex
1525 (eyedrop-background-at-point)))))))
1526 (let ((ipc ()))
1527 (mapatoms
1528 (lambda (cand)
1529 (when (and (user-variable-p cand)
1530 (condition-case nil (icicle-var-is-of-type-p cand '(color)) (error nil))
1531 ;; This should not be necessary, but type `color' isn't
1532 ;; enforced - it just means `string' (so far).
1533 (x-color-defined-p (symbol-value cand)))
1534 (push `,(icicle-make-color-candidate
1535 (concat "'" (symbol-name cand) "'")
1536 (downcase (hexrgb-color-name-to-hex (symbol-value cand))))
1537 ipc))))
1538 ipc)))))
1539
1540 (defun icicle-color-help (color)
1541 "Display help on COLOR.
1542 COLOR is a color name, an RGB string, or a multi-completion of both.
1543 If only a color name, then just say \"No help\"."
1544 (if (not (member icicle-list-use-nth-parts '((1 2) (2))))
1545 (icicle-msg-maybe-in-minibuffer "No help")
1546 (icicle-with-help-window "*Help*"
1547 (princ (format "Color: %s" color)) (terpri) (terpri)
1548 (let* ((icicle-list-use-nth-parts '(2))
1549 (colr (icicle-transform-multi-completion color))
1550 (rgb (hexrgb-hex-to-rgb colr))
1551 (hsv (apply #'hexrgb-rgb-to-hsv rgb)))
1552 (princ "RGB:")
1553 (mapcar (lambda (component) (princ (format " %.18f" component))) rgb)
1554 (terpri) (terpri)
1555 (princ "HSV:")
1556 (mapcar (lambda (component) (princ (format " %.18f" component))) hsv)))))
1557
1558 (defun icicle-make-color-candidate (color-name &optional hex-rgb)
1559 "Return multi-completion candidate of COLOR-NAME and its hex RGB string.
1560 If `icicle-WYSIWYG-Completions-flag' is non-nil, then the hex RGB
1561 string has the color as its background text property.
1562 Optional arg HEX-RGB is the hex RGB string. If HEX-RGB is nil, then
1563 COLOR-NAME is used to determine the hex RGB string."
1564 (let* ((rgb-string (or hex-rgb (hexrgb-color-name-to-hex color-name)))
1565 (value (hexrgb-value rgb-string)))
1566 (when icicle-WYSIWYG-Completions-flag
1567 (put-text-property 0 (length rgb-string) 'face
1568 (list (cons 'foreground-color (if (< value 0.6) "White" "Black"))
1569 (cons 'background-color rgb-string))
1570 rgb-string))
1571 (when (or (> icicle-help-in-mode-line-delay 0) ; Construct help only if user will see it.
1572 (and (boundp 'tooltip-mode) tooltip-mode))
1573 (let* ((rgb (hexrgb-hex-to-rgb rgb-string))
1574 (hsv (apply #'hexrgb-rgb-to-hsv rgb))
1575 (help (format "RGB: %.6f, %.6f, %.6f; HSV: %.6f, %.6f, %.6f"
1576 (nth 0 rgb) (nth 1 rgb) (nth 2 rgb)
1577 (nth 0 hsv) (nth 1 hsv) (nth 2 hsv))))
1578 (icicle-candidate-short-help help color-name)
1579 (icicle-candidate-short-help help rgb-string)))
1580 (list (list color-name rgb-string))))
1581
1582 ;; This predicate is used for color completion.
1583 (defun icicle-color-red-lessp (s1 s2)
1584 "Non-nil means the RGB in S1 has less red than in S2.
1585 The strings are assumed to have at least two parts, with the parts
1586 separated by `icicle-list-join-string' The RGB values are assumed to
1587 be the second parts of the strings, and they are assumed to start with
1588 `#'."
1589 (let ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1590 (rgb2 (elt (split-string s2 icicle-list-join-string) 1)))
1591 (and rgb1 rgb2 (< (hexrgb-red rgb1) (hexrgb-red rgb2))))) ; Just in case strings were not multipart.
1592
1593 ;; This predicate is used for color completion.
1594 (defun icicle-color-green-lessp (s1 s2)
1595 "Non-nil means the RGB in S1 has less green than in S2.
1596 The strings are assumed to have at least two parts, with the parts
1597 separated by `icicle-list-join-string' The RGB values are assumed to
1598 be the second parts of the strings, and they are assumed to start with
1599 `#'."
1600 (let ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1601 (rgb2 (elt (split-string s2 icicle-list-join-string) 1)))
1602 (and rgb1 rgb2 (< (hexrgb-green rgb1) (hexrgb-green rgb2))))) ; Just in case strings not multipart.
1603
1604 ;; This predicate is used for color completion.
1605 (defun icicle-color-blue-lessp (s1 s2)
1606 "Non-nil means the RGB in S1 has less blue than in S2.
1607 The strings are assumed to have at least two parts, with the parts
1608 separated by `icicle-list-join-string' The RGB values are assumed to
1609 be the second parts of the strings, and they are assumed to start with
1610 `#'."
1611 (let ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1612 (rgb2 (elt (split-string s2 icicle-list-join-string) 1)))
1613 (and rgb1 rgb2 (< (hexrgb-blue rgb1) (hexrgb-blue rgb2))))) ; Just in case strings were not multipart.
1614
1615 ;; This predicate is used for color completion.
1616 (defun icicle-color-distance-rgb-lessp (s1 s2)
1617 "Return non-nil if color S1 is RGB-closer than S2 to the base color.
1618 S1 and S2 are color names (strings).
1619
1620 The base color name is the cdr of option `list-colors-sort', whose car
1621 must be `rgb-dist'. If the option value is not already a cons with
1622 car `rgb-dist' then it is made so: you are prompted for the base color
1623 name to use."
1624 (let* ((base-color (if (and (boundp 'list-colors-sort) ; Emacs 23+
1625 (consp list-colors-sort) (eq 'rgb-dist (car list-colors-sort)))
1626 (cdr list-colors-sort) ; `list-colors-sort' is free here.
1627 (cdr (setq list-colors-sort
1628 (cons 'rgb-dist
1629 (let ((enable-recursive-minibuffers t)
1630 (icicle-sort-comparer nil))
1631 (icicle-read-color-WYSIWYG ; Use the color name only.
1632 0 "With RGB close to color: ")))))))
1633 (base-rgb (hexrgb-hex-to-rgb (hexrgb-color-name-to-hex base-color)))
1634 (base-red (nth 0 base-rgb))
1635 (base-green (nth 1 base-rgb))
1636 (base-blue (nth 2 base-rgb))
1637 (s1-rgb (hexrgb-hex-to-rgb (elt (split-string s1 icicle-list-join-string) 1)))
1638 (s2-rgb (hexrgb-hex-to-rgb (elt (split-string s2 icicle-list-join-string) 1))))
1639 (< (+ (expt (- (nth 0 s1-rgb) base-red) 2)
1640 (expt (- (nth 1 s1-rgb) base-green) 2)
1641 (expt (- (nth 2 s1-rgb) base-blue) 2))
1642 (+ (expt (- (nth 0 s2-rgb) base-red) 2)
1643 (expt (- (nth 1 s2-rgb) base-green) 2)
1644 (expt (- (nth 2 s2-rgb) base-blue) 2)))))
1645
1646 ;; This predicate is used for color completion.
1647 (defun icicle-color-hue-lessp (s1 s2)
1648 "Non-nil means the RGB hue in S1 is less than that in S2.
1649 The strings are assumed to have at least two parts, with the parts
1650 separated by `icicle-list-join-string' The RGB values are assumed to
1651 be the second parts of the strings, and they are assumed to start with
1652 `#'."
1653 (let ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1654 (rgb2 (elt (split-string s2 icicle-list-join-string) 1)))
1655 (and rgb1 rgb2 (< (hexrgb-hue rgb1) (hexrgb-hue rgb2))))) ; Just in case strings were not multipart.
1656
1657 ;; This predicate is used for color completion.
1658 (defun icicle-color-saturation-lessp (s1 s2)
1659 "Non-nil means the RGB in S1 is less saturated than in S2.
1660 The strings are assumed to have at least two parts, with the parts
1661 separated by `icicle-list-join-string' The RGB values are assumed to
1662 be the second parts of the strings, and they are assumed to start with
1663 `#'."
1664 (let ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1665 (rgb2 (elt (split-string s2 icicle-list-join-string) 1)))
1666 (and rgb1 rgb2 (< (hexrgb-saturation rgb1) (hexrgb-saturation rgb2))))) ; For non-multipart strings.
1667
1668 ;; This predicate is used for color completion.
1669 (defun icicle-color-value-lessp (s1 s2)
1670 "Non-nil means the RGB value in S1 is darker than that in S2.
1671 The strings are assumed to have at least two parts, with the parts
1672 separated by `icicle-list-join-string' The RGB values are assumed to
1673 be the second parts of the strings, and they are assumed to start with
1674 `#'."
1675 (let ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1676 (rgb2 (elt (split-string s2 icicle-list-join-string) 1)))
1677 (and rgb1 rgb2 (< (hexrgb-value rgb1) (hexrgb-value rgb2))))) ; Just in case strings not multipart.
1678
1679 ;; This predicate is used for color completion.
1680 (defun icicle-color-hsv-lessp (s1 s2)
1681 "Non-nil means the HSV components of S1 are less than those of S2.
1682 Specifically, the hues are compared first, then if hues are equal then
1683 saturations are compared, then if those are also equal values are
1684 compared.
1685 The strings are assumed to have at least two parts, with the parts
1686 separated by `icicle-list-join-string' The second parts of the strings
1687 are RGB triplets that start with `#'."
1688 (let* ((rgb1 (elt (split-string s1 icicle-list-join-string) 1))
1689 (hsv1 (and rgb1 (hexrgb-hex-to-hsv rgb1)))
1690 (rgb2 (elt (split-string s2 icicle-list-join-string) 1))
1691 (hsv2 (and rgb2 (hexrgb-hex-to-hsv rgb2))))
1692 (and hsv1 hsv2 ; Just in case strings were not multipart.
1693 (or (< (nth 0 hsv1) (nth 0 hsv2))
1694 (and (= (nth 0 hsv1) (nth 0 hsv2))
1695 (< (nth 1 hsv1) (nth 1 hsv2)))
1696 (and (= (nth 0 hsv1) (nth 0 hsv2))
1697 (= (nth 1 hsv1) (nth 1 hsv2))
1698 (< (nth 2 hsv1) (nth 2 hsv2)))))))
1699
1700 ;; This predicate is used for color completion.
1701 (defun icicle-color-distance-hsv-lessp (s1 s2)
1702 "Return non-nil if color S1 is HSV-closer than S2 to the base color.
1703 S1 and S2 are color names (strings).
1704
1705 The base color name is the cdr of option `list-colors-sort', whose car
1706 must be `hsv-dist'. If the option value is not already a cons with
1707 car `hsv-dist' then it is made so: you are prompted for the base color
1708 name to use."
1709 (let* ((base-color (if (and (boundp 'list-colors-sort) ; Emacs 23+
1710 (consp list-colors-sort)
1711 (eq 'hsv-dist (car list-colors-sort)))
1712 (cdr list-colors-sort) ; `list-colors-sort' is free here.
1713 (cdr (setq list-colors-sort
1714 (cons 'hsv-dist
1715 (let ((enable-recursive-minibuffers t)
1716 (icicle-sort-comparer nil))
1717 (icicle-read-color-WYSIWYG ; Use the color name only.
1718 0 "With HSV close to color: ")))))))
1719 (base-hsv (hexrgb-hex-to-hsv (hexrgb-color-name-to-hex base-color)))
1720 (base-hue (nth 0 base-hsv))
1721 (base-sat (nth 1 base-hsv))
1722 (base-val (nth 2 base-hsv))
1723 (s1-hsv (apply #'hexrgb-rgb-to-hsv
1724 (hexrgb-hex-to-rgb
1725 (elt (split-string s1 icicle-list-join-string) 1))))
1726 (s2-hsv (apply #'hexrgb-rgb-to-hsv
1727 (hexrgb-hex-to-rgb
1728 (elt (split-string s2 icicle-list-join-string) 1)))))
1729 (< (+ (expt (- (nth 0 s1-hsv) base-hue) 2)
1730 (expt (- (nth 1 s1-hsv) base-sat) 2)
1731 (expt (- (nth 2 s1-hsv) base-val) 2))
1732 (+ (expt (- (nth 0 s2-hsv) base-hue) 2)
1733 (expt (- (nth 1 s2-hsv) base-sat) 2)
1734 (expt (- (nth 2 s2-hsv) base-val) 2)))))
1735 )
1736
1737
1738 (defun icicle-cmd2-after-load-highlight ()
1739 "Things to do for `icicles-cmd2.el' after loading `highlight.el'."
1740 (when (fboundp 'next-single-char-property-change) ; Don't bother, for Emacs 20.
1741
1742 (icicle-define-command icicle-choose-faces
1743 "Choose a list of face names (strings).
1744 Option `hlt-act-on-any-face-flag' determines whether only highlighting
1745 faces in the buffer are candidates. The list of names (strings) is
1746 returned."
1747 (lambda (name) (push name face-names)) ; Action function
1748 prompt ; `completing-read' args
1749 (mapcar #'icicle-make-face-candidate
1750 (if hlt-act-on-any-face-flag
1751 (face-list)
1752 (hlt-highlight-faces-in-buffer (point-min) (point-max))))
1753 nil (not (stringp icicle-WYSIWYG-Completions-flag)) nil
1754 (if (boundp 'face-name-history) 'face-name-history 'icicle-face-name-history) nil nil
1755 ((icicle-list-nth-parts-join-string ": ") ; Additional bindings
1756 (icicle-list-join-string ": ")
1757 (icicle-multi-completing-p t)
1758 (icicle-list-use-nth-parts '(1))
1759 (icicle-face-completing-p t)
1760 (prompt (copy-sequence "Choose face (`RET' when done): "))
1761 (face-names ()))
1762 (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code.
1763 nil ; Undo code.
1764 (prog1 (setq face-names (delete "" face-names)) ; Last code - return the list of faces.
1765 (when (interactive-p) (message "Faces: %S" face-names))))
1766
1767 (icicle-define-command icicle-choose-invisible-faces
1768 "Choose a list of face names (strings) from currently invisible faces.
1769 Option `hlt-act-on-any-face-flag' determines whether only highlighting
1770 faces in the buffer are candidates. The list of names (strings) is
1771 returned."
1772 (lambda (name) (push name face-names)) ; Action function
1773 prompt ; `completing-read' args
1774 (mapcar #'icicle-make-face-candidate
1775 (icicle-remove-if-not #'icicle-invisible-face-p
1776 (if hlt-act-on-any-face-flag
1777 (face-list)
1778 (hlt-highlight-faces-in-buffer (point-min) (point-max)))))
1779 nil (not (stringp icicle-WYSIWYG-Completions-flag)) nil
1780 (if (boundp 'face-name-history) 'face-name-history 'icicle-face-name-history) nil nil
1781 ((icicle-list-nth-parts-join-string ": ") ; Additional bindings
1782 (icicle-list-join-string ": ")
1783 (icicle-multi-completing-p t)
1784 (icicle-list-use-nth-parts '(1))
1785 (icicle-face-completing-p t)
1786 (prompt (copy-sequence "Choose face (`RET' when done): "))
1787 (face-names ()))
1788 (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code.
1789 nil ; Undo code.
1790 (prog1 (setq face-names (delete "" face-names)) ; Last code - return the list of faces.
1791 (when (interactive-p) (message "Faces: %S" face-names))))
1792
1793 (icicle-define-command icicle-choose-visible-faces
1794 "Choose a list of face names (strings) from currently visible faces.
1795 Option `hlt-act-on-any-face-flag' determines whether only highlighting
1796 faces in the buffer are candidates. The list of names (strings) is
1797 returned."
1798 (lambda (name) (push name face-names)) ; Action function
1799 prompt ; `completing-read' args
1800 (mapcar #'icicle-make-face-candidate
1801 (icicle-remove-if #'icicle-invisible-face-p
1802 (if hlt-act-on-any-face-flag
1803 (face-list)
1804 (hlt-highlight-faces-in-buffer (point-min) (point-max)))))
1805 nil (not (stringp icicle-WYSIWYG-Completions-flag)) nil
1806 (if (boundp 'face-name-history) 'face-name-history 'icicle-face-name-history) nil nil
1807 ((icicle-list-nth-parts-join-string ": ") ; Additional bindings
1808 (icicle-list-join-string ": ")
1809 (icicle-multi-completing-p t)
1810 (icicle-list-use-nth-parts '(1))
1811 (icicle-face-completing-p t)
1812 (prompt (copy-sequence "Choose face (`RET' when done): "))
1813 (face-names ()))
1814 (put-text-property 0 1 'icicle-fancy-candidates t prompt) ; First code.
1815 nil ; Undo code.
1816 (prog1 (setq face-names (delete "" face-names)) ; Last code - return the list of faces.
1817 (when (interactive-p) (message "Faces: %S" face-names))))
1818
1819 (defun icicle-show-only-faces (&optional start end faces)
1820 "Show only the faces you choose, hiding all others.
1821 Non-nil `hlt-act-on-any-face-flag' means choose from among all
1822 faces. Nil means choose only from among faces used to highlight.
1823
1824 When choosing faces, completion and cycling are available. During
1825 cycling, these keys with prefix `C-' act on the current face name\\<minibuffer-local-completion-map>:
1826
1827 `C-mouse-2', `C-RET' - Choose current face candidate only
1828 `C-down' - Choose, then move to next prefix-completion candidate
1829 `C-up' - Choose, then move to previous prefix-completion candidate
1830 `C-next' - Choose, then move to next apropos-completion candidate
1831 `C-prior' - Choose, then move to previous apropos-completion candidate
1832 `\\[icicle-all-candidates-action]' - Choose *all* matching face names"
1833 (interactive `(,@(hlt-region-or-buffer-limits)
1834 ,(mapcar #'intern (icicle-choose-faces)))) ; An Icicles multi-command
1835 (dolist (face (if hlt-act-on-any-face-flag
1836 (face-list)
1837 (hlt-highlight-faces-in-buffer start end)))
1838 (if (memq face faces)
1839 (hlt-show-default-face face)
1840 (hlt-hide-default-face start end face))))
1841
1842 (defun icicle-hide-only-faces (&optional start end faces)
1843 "Hide only the faces you choose, showing all others.
1844 Non-nil `hlt-act-on-any-face-flag' means choose from among all
1845 faces. Nil means choose only from among faces used to highlight.
1846
1847 When choosing faces, completion and cycling are available. During
1848 cycling, these keys with prefix `C-' act on the current face name\\<minibuffer-local-completion-map>:
1849
1850 `C-mouse-2', `C-RET' - Choose current face candidate only
1851 `C-down' - Choose, then move to next prefix-completion candidate
1852 `C-up' - Choose, then move to previous prefix-completion candidate
1853 `C-next' - Choose, then move to next apropos-completion candidate
1854 `C-prior' - Choose, then move to previous apropos-completion candidate
1855 `\\[icicle-all-candidates-action]' - Choose *all* matching face names"
1856 (interactive `(,@(hlt-region-or-buffer-limits)
1857 ,(mapcar #'intern (icicle-choose-faces)))) ; An Icicles multi-command
1858 (dolist (face (if hlt-act-on-any-face-flag
1859 (face-list)
1860 (hlt-highlight-faces-in-buffer start end)))
1861 (if (memq face faces)
1862 (hlt-hide-default-face start end face)
1863 (hlt-show-default-face face))))
1864
1865 (defun icicle-show-faces (faces)
1866 "Show invisible faces that you choose. Do nothing to other faces.
1867 Non-nil `hlt-act-on-any-face-flag' means choose from among all
1868 invisible faces. Nil means choose only from among invisible faces
1869 used to highlight.
1870
1871 When choosing faces, completion and cycling are available. During
1872 cycling, these keys with prefix `C-' act on the current face name\\<minibuffer-local-completion-map>:
1873
1874 `C-mouse-2', `C-RET' - Choose current face candidate only
1875 `C-down' - Choose, then move to next prefix-completion candidate
1876 `C-up' - Choose, then move to previous prefix-completion candidate
1877 `C-next' - Choose, then move to next apropos-completion candidate
1878 `C-prior' - Choose, then move to previous apropos-completion candidate
1879 `\\[icicle-all-candidates-action]' - Choose *all* matching face names"
1880 (interactive
1881 (list (let ((fs (icicle-remove-if-not #'icicle-invisible-face-p
1882 (if hlt-act-on-any-face-flag
1883 (face-list)
1884 (hlt-highlight-faces-in-buffer
1885 (point-min) (point-max))))))
1886 (if fs
1887 (mapcar #'intern (icicle-choose-invisible-faces)) ; An Icicles multi-command
1888 (icicle-user-error "No%s faces are invisible"
1889 (if hlt-act-on-any-face-flag "" " highlight"))))))
1890 (dolist (face faces) (hlt-show-default-face face)))
1891
1892 (defun icicle-hide-faces (&optional start end faces)
1893 "Hide visible faces that you choose. Do nothing to other faces.
1894 Non-nil `hlt-act-on-any-face-flag' means choose from among all
1895 visible faces. Nil means choose only from among visible faces used to
1896 highlight.
1897
1898 When choosing faces, completion and cycling are available. During
1899 cycling, these keys with prefix `C-' act on the current face name\\<minibuffer-local-completion-map>:
1900
1901 `C-mouse-2', `C-RET' - Choose current face candidate only
1902 `C-down' - Choose, then move to next prefix-completion candidate
1903 `C-up' - Choose, then move to previous prefix-completion candidate
1904 `C-next' - Choose, then move to next apropos-completion candidate
1905 `C-prior' - Choose, then move to previous apropos-completion candidate
1906 `\\[icicle-all-candidates-action]' - Choose *all* matching face names"
1907 (interactive `(,@(hlt-region-or-buffer-limits)
1908 ,(mapcar #'intern (icicle-choose-faces)))) ; An Icicles multi-command
1909 (dolist (face faces) (hlt-hide-default-face start end face)))))
1910
1911
1912 (defun icicle-cmd2-after-load-wid-edit+ ()
1913 "Things to do for `icicles-cmd2.el' after loading `wid-edit+.el'."
1914
1915 ;; Save vanilla `color' widget as `icicle-ORIG-color' widget, for restoring when you quit Icicle mode.
1916 (unless (get 'icicle-ORIG-color 'widget-type)
1917 (put 'icicle-ORIG-color 'widget-type (get 'color 'widget-type))
1918 (put 'icicle-ORIG-color 'widget-documentation (get 'color 'widget-documentation)))
1919
1920 (define-widget 'icicle-color 'editable-field
1921 "Icicles version of the `color' widget.
1922 `M-TAB' completes the color name using Icicles WYSIWYG completion.
1923 See `icicle-widget-color-complete'."
1924 :format "%{%t%}: %v (%{sample%})\n"
1925 :size (1+ (apply #'max (mapcar #'length (x-defined-colors))))
1926 :tag "Color"
1927 :match 'widgetp-color-match
1928 :validate 'widgetp-color-validate
1929 :value "black"
1930 :complete 'icicle-widget-color-complete
1931 :sample-face-get 'widget-color-sample-face-get
1932 :notify 'widget-color-notify
1933 :action 'widget-color-action)
1934
1935 ;; Emacs < 24 defines `widget-color-complete'. Save that as `icicle-ORIG-*'. Do nothing for Emacs 24+.
1936 (unless (or (> emacs-major-version 23) (fboundp 'icicle-ORIG-widget-color-complete))
1937 (require 'wid-edit)
1938 (when (fboundp 'widget-color-complete)
1939 (fset 'icicle-ORIG-widget-color-complete (symbol-function 'widget-color-complete))))
1940
1941 (defun icicle-widget-color-complete (widget)
1942 "Complete the color name in `color' widget WIDGET.
1943 If you use Icicles, then you get Icicles completion (apropos,
1944 progressive, complementing...).
1945
1946 If, in addition, option `icicle-WYSIWYG-Completions-flag' is non-nil:
1947
1948 * Completion is WYSIWYG. Each candidate is a color name followed by
1949 its RGB value as a color swatch. You can complete against any of
1950 this text (name, RGB, or part or all of both). Or you can enter an
1951 RGB value that has no color name without completing.
1952
1953 * With a prefix arg, when you choose a completion its RGB value is
1954 used, not the color name.
1955
1956 If, in addition, option `icicle-add-proxy-candidates-flag' is non-nil
1957 and library `palette.el' or `eyedropper.el' is available, then the
1958 following Icicles proxy candidates are available during completion:
1959
1960 * `*copied foreground*' - last copied foreground, if available
1961 * `*copied background*' - last copied background, if available
1962 * `*mouse-2 foreground*' - foreground where you click `mouse-2'
1963 * `*mouse-2 background*' - background where you click `mouse-2'
1964 * `*point foreground*' - foreground under the text cursor
1965 * `*point background*' - background under the text cursor
1966
1967 \(You can copy a color using eyedropper commands such as
1968 `eyedrop-pick-foreground-at-mouse'.)
1969
1970 In addition, the names of user options (variables) whose custom type
1971 is `color' are also proxy candidates, but with `'' as a prefix and
1972 suffix. So, for example, option `icicle-region-background' appears as
1973 proxy color candidate `'icicle-region-background''. If you choose
1974 such a candidate then (only) the variable's value (color name or RGB)
1975 is returned.
1976
1977 As always in Icicles, you can toggle the use of proxy candidates using
1978 `\\<minibuffer-local-completion-map>\\[icicle-toggle-proxy-candidates]' in the minibuffer.
1979
1980 See `icicle-read-color-WYSIWYG' for more information."
1981 (let* ((prefix (buffer-substring-no-properties (widget-field-start widget) (point)))
1982 ;; Free variables here: `eyedrop-picked-foreground', `eyedrop-picked-background'.
1983 ;; They are defined in library `palette.el' or library `eyedropper.el'.
1984 (colors (if (fboundp 'hexrgb-defined-colors-alist) ; Defined in `hexrgb.el'.
1985 (if (fboundp 'eyedrop-foreground-at-point)
1986 (append (and eyedrop-picked-foreground '(("*copied foreground*")))
1987 (and eyedrop-picked-background '(("*copied background*")))
1988 '(("*mouse-2 foreground*") ("*mouse-2 background*")
1989 ("*point foreground*") ("*point background*"))
1990 (hexrgb-defined-colors-alist))
1991 (hexrgb-defined-colors-alist))
1992 (mapcar #'list (x-defined-colors))))
1993 (icicle-color-completing t)
1994 (completion (try-completion prefix colors)))
1995 (cond ((null completion)
1996 (widgetp-remove-Completions)
1997 (error "No completion for \"%s\"" prefix))
1998 ((eq completion t)
1999 (widgetp-remove-Completions)
2000 (message "Sole completion"))
2001 ((and (not (string-equal prefix completion))
2002 (or (not (boundp 'icicle-mode)) (not icicle-mode)))
2003 (insert-and-inherit (substring completion (length prefix)))
2004 (message "Making completion list...")
2005 (widgetp-display-Completions prefix colors)
2006 (message "Completed, but not unique"))
2007 ((or (not (boundp 'icicle-mode)) (not icicle-mode))
2008 (message "Making completion list...")
2009 (widgetp-display-Completions prefix colors))
2010 (t
2011 (let* ((enable-recursive-minibuffers (active-minibuffer-window))
2012 (icicle-top-level-when-sole-completion-flag t)
2013 (icicle-show-Completions-initially-flag t)
2014 (icicle-unpropertize-completion-result-flag t)
2015 (completion-ignore-case t)
2016 (field (widget-field-find (point)))
2017 (beg (widget-field-start field))
2018 (end (max (point)
2019 (if (fboundp 'widget-field-text-end)
2020 (widget-field-text-end field)
2021 (widget-field-end field))))
2022
2023 (color
2024 (if (and (fboundp 'icicle-read-color-WYSIWYG) icicle-WYSIWYG-Completions-flag)
2025 (icicle-read-color-WYSIWYG (if current-prefix-arg 99 0)
2026 "Color (name or #R+G+B+): " prefix 'MSGP)
2027 (completing-read "Color: " colors nil nil prefix))))
2028 (delete-region beg end)
2029 (insert-and-inherit color)
2030 (message "Completed"))))))
2031 )
2032
2033
2034 (defun icicle-cmd2-after-load-palette ()
2035 "Things to do for `icicles-cmd2.el' after loading `palette.el'."
2036
2037 (defun icicle-pick-color-by-name (color &optional msgp) ; Bound to `c' and `M-c' in color palette.
2038 "Set the current palette color to a color you name.
2039 Instead of a color name, you can use an RGB string #XXXXXXXXXXXX,
2040 where each X is a hex digit. The number of Xs must be a multiple of
2041 3, with the same number of Xs for each of red, green, and blue.
2042 If you enter an empty color name, then a color is picked randomly.
2043 The new current color is returned.
2044
2045 When called from Lisp, non-nil MSGP means echo the chosen color name."
2046 (interactive (let ((completion-ignore-case t)
2047 (icicle-color-completing-p t)
2048 (icicle-candidate-action-fn 'icicle-pick-color-by-name-action)
2049 (icicle-list-use-nth-parts '(1)))
2050 (list (icicle-read-color nil nil t) 'MSG)))
2051 (icicle-pick-color-by-name-1 color msgp))
2052
2053 (defun icicle-pick-color-by-name-action (raw-input)
2054 "Action function for `icicle-pick-color-by-name'."
2055 (let ((color (icicle-color-from-multi-completion-input raw-input 'MSG)))
2056 (icicle-pick-color-by-name-1 color)))
2057
2058 (defun icicle-pick-color-by-name-1 (color &optional msgp)
2059 "Set the current palette color to COLOR.
2060 If the palette is displayed, redisplay it, moving the cursor to COLOR.
2061 Non-nil MSGP means echo the chosen color name."
2062 (setq palette-last-color palette-current-color
2063 color (hexrgb-color-name-to-hex color))
2064 (save-selected-window
2065 (palette-set-current-color color)
2066 (when (get-buffer-window "Palette (Hue x Saturation)" 'visible)
2067 (palette-where-is-color color)
2068 (palette-brightness-scale)
2069 (palette-swatch)))
2070 (prog1 palette-current-color
2071 (when msgp (message "Palette color (RGB) is now `%s'" palette-current-color))))
2072
2073 (define-key palette-mode-map (icicle-kbd "c") 'icicle-pick-color-by-name)
2074 (define-key palette-mode-map (icicle-kbd "\M-c") 'icicle-pick-color-by-name)
2075 (define-key palette-popup-map [pick-color-by-name] ; Use same name as in `palette.el'.
2076 `(menu-item "Choose Color By Name" icicle-pick-color-by-name
2077 :help "Set the current color to a color you name"))
2078 )
2079
2080
2081 (defun icicle-cmd2-after-load-synonyms ()
2082 "Things to do for `icicles-cmd2.el' after loading `synonyms.el'."
2083 (defalias 'synonyms 'icicle-synonyms)
2084 (icicle-define-command icicle-synonyms ; Command
2085 "Show synonyms that match a regular expression (e.g. a word or phrase).
2086 You are prompted for the regexp. By default, it is the text
2087 of the region, if it is active and `transient-mark-mode' is enabled,
2088 or the nearest word to the cursor, if not.
2089
2090 Option `synonyms-match-more-flag' non-nil means additional thesaurus
2091 entries can be matched. This can be more time-consuming. It means
2092 two things:
2093
2094 1) Input can match parts of synonyms, in addition to whole synonyms.
2095 2) All synonyms are shown, even if input matches a thesaurus entry.
2096
2097 Option `synonyms-append-result-flag' non-nil means to append search
2098 result to previous results.
2099
2100 A prefix argument toggles the meaning of each of those options for the
2101 duration of the command:
2102
2103 If `C-u' or `C-u C-u', then toggle `synonyms-match-more-flag'.
2104 If negative or `C-u C-u', then toggle `synonyms-append-result-flag'.
2105
2106 \(`C-u C-u' thus means toggle both options.)
2107
2108 When called from Lisp, optional second argument REGEXP is the regexp
2109 to match (no prompting)." ; Doc string
2110 synonyms-action ; Action function, defined in `synonyms.el'.
2111 "Show synonyms for word or phrase (regexp): " ; `completing-read' arguments
2112 synonyms-obarray nil nil nil 'synonyms-history (synonyms-default-regexp) nil
2113 ((num-arg (prefix-numeric-value current-prefix-arg)) ; Bindings
2114 (morep (eq synonyms-match-more-flag (atom current-prefix-arg)))
2115 (appendp (eq synonyms-append-result-flag (and (wholenump num-arg) (/= 16 num-arg))))
2116 (icicle-sort-comparer 'icicle-case-insensitive-string-less-p))
2117 (synonyms-ensure-synonyms-read-from-cache)) ; First code: initialize `synonyms-obarray', for completion.
2118
2119 (icicle-define-command icicle-insert-thesaurus-entry ; Command name
2120 "Insert an entry from a thesaurus.
2121 Library `synonyms.el' is needed for this. If you have never used
2122 command `synonyms' before, then the first use of
2123 `icicle-insert-thesaurus-entry' will take a while, because it will
2124 build a cache file of synonyms that are used for completion. See
2125 `synonyms.el'.
2126
2127 Remember that you can use `\\<minibuffer-local-completion-map>\
2128 \\[icicle-cycle-incremental-completion] to toggle incremental completion." ; Doc string
2129 icicle-insert-thesaurus-entry-cand-fn ; Action function
2130 "Thesaurus entry to match: " synonyms-obarray ; `completing-read' args
2131 nil t nil 'icicle-dictionary-history nil nil
2132 ((icicle-track-pt (point))) ; Bindings
2133 (progn ; First code
2134 (unless (or (boundp 'synonyms-obarray) (require 'synonyms nil t))
2135 (icicle-user-error "You must first load library `synonyms.el'"))
2136 (synonyms-ensure-synonyms-read-from-cache))
2137 nil ; Undo code
2138 (when (window-live-p icicle-orig-window) ; Last code
2139 (select-window icicle-orig-window)
2140 (select-frame-set-input-focus (selected-frame))
2141 (goto-char icicle-track-pt)))
2142
2143 ;; Free vars here: `icicle-orig-buff' is bound in `icicle-insert-thesaurus-entry'.
2144 (defun icicle-insert-thesaurus-entry-cand-fn (string)
2145 "Action function for `icicle-insert-thesaurus-entry'.
2146 Insert STRING, followed by a space, at position TRACK-PT of buffer
2147 ORIG-BUFF."
2148 (set-buffer icicle-orig-buff)
2149 (goto-char icicle-track-pt)
2150 (insert string " ")
2151 (setq icicle-track-pt (point))
2152 (unless (pos-visible-in-window-p) (recenter icicle-recenter))
2153 (with-current-buffer (window-buffer (minibuffer-window)) (icicle-clear-minibuffer))
2154 (save-selected-window (icicle-remove-Completions-window)))
2155
2156 (defun icicle-complete-thesaurus-entry (word) ; Bound to `C-c /' in Icicle mode.
2157 "Complete WORD to an entry from a thesaurus.
2158 The default value of WORD is the word at the cursor.
2159 Library `synonyms.el' is needed for this. If you have never used
2160 command `synonyms' before, then the first use of
2161 `icicle-insert-thesaurus-entry' will take a while, because it will
2162 build a cache file of synonyms that are used for completion. See
2163 `synonyms.el'."
2164 (interactive (list (word-at-point)))
2165 (unless word (icicle-user-error "No word at point to complete"))
2166 (unless (or (boundp 'synonyms-obarray) (require 'synonyms nil t))
2167 (icicle-user-error "You must first load library `synonyms.el'"))
2168 (synonyms-ensure-synonyms-read-from-cache)
2169 (when (and (looking-at "\\b") (not (looking-at "\\s-"))) (forward-word 1))
2170 (delete-region (progn (forward-word -1) (point)) (progn (forward-word 1) (point)))
2171 (insert (completing-read "Thesaurus entry to match: " synonyms-obarray
2172 nil nil word 'icicle-dictionary-history word))
2173 (unless (looking-at "\\s-") (insert " ")))
2174 )
2175
2176
2177
2178 ;;; Library `Bookmark+' - Icicles multi-commands.
2179 ;;;
2180 (eval-after-load "bookmark+" '(icicle-cmd2-after-load-bookmark+))
2181
2182
2183 ;;; Library `hexrgb.el' - Icicles multi-commands.
2184 ;;;
2185 (eval-after-load "hexrgb" '(icicle-cmd2-after-load-hexrgb))
2186
2187
2188 ;;; Library `highlight.el' - Icicles multi-commands. Emacs 21+.
2189 ;;;
2190 (eval-after-load "highlight" '(icicle-cmd2-after-load-highlight))
2191
2192
2193 ;;; Library `palette.el' - Icicles multi-commands.
2194 ;;;
2195 (eval-after-load "palette" '(icicle-cmd2-after-load-palette))
2196
2197
2198 ;;; Library `synonyms.el' - Icicles multi-commands.
2199 ;;;
2200 (eval-after-load "synonyms" '(icicle-cmd2-after-load-synonyms))
2201
2202
2203 ;;; Library `wid-edit+.el' - Icicles function and widget.
2204 ;;;
2205 (eval-after-load "wid-edit+" '(icicle-cmd2-after-load-wid-edit+))
2206
2207 ;;(@* "Icicles Top-Level Commands, Part 2")
2208
2209 ;;; Icicles Top-Level Commands, Part 2 -------------------------------
2210
2211 (when (> emacs-major-version 20)
2212 (icicle-define-command icicle-load-library
2213 "Multi-command version of `load-library'."
2214 load-library
2215 "Load library: "
2216 (if (fboundp 'locate-file-completion-table)
2217 (apply-partially 'locate-file-completion-table load-path (get-load-suffixes))
2218 (lambda (string _IGNORE action)
2219 (locate-file-completion string (cons load-path (get-load-suffixes)) action)))
2220 nil t nil nil nil nil
2221 ;; Vanilla Emacs does not remove dups - see bug #16208.
2222 ((icicle-transform-function #'icicle-remove-duplicates))))
2223
2224
2225 (defvar icicle-orig-font nil
2226 "Font of selected frame, before command.")
2227
2228 (defvar icicle-orig-frame nil
2229 "Selected frame, before command.")
2230
2231 (defvar icicle-orig-menu-bar nil
2232 "`menu-bar-lines' of selected frame, before command.")
2233
2234 (defvar icicle-orig-pixelsize nil
2235 "Size of font of selected frame in pixels, before command.")
2236
2237 (defvar icicle-orig-pointsize nil
2238 "Size of font of selected frame in points, before command.")
2239
2240 (icicle-define-command icicle-font ; Command name
2241 "Change font of current frame.
2242 Completion candidates are font names in XLFD form. See the Emacs
2243 manual, node `Fonts'.
2244
2245 If option `icicle-WYSIWYG-Completions-flag' is non-nil then show font
2246 names in `*Completions*' more or less in their own font, and
2247 abbreviated to not include the last 8 XLFD fields (PIXELS, HEIGHT,
2248 HORIZ, VERT, SPACING, WIDTH, REGISTRY, and ENCODING).
2249
2250 If `icicle-WYSIWYG-Completions-flag' is non-nil then the font names
2251 are not shown using their fonts and full XLFD font names are used.
2252 Full names means that all available variants are available as separate
2253 candidates (different REGISTRY entries etc.).
2254
2255 You can toggle `icicle-WYSIWYG-Completions-flag' using `C-S-pause',
2256 but the change takes effect only for the next act of completion; so,
2257 use `C-g' and repeat the current command to see the effect.
2258
2259 With WYSIWYG display, the first use of `icicle-font' in a session
2260 might take a while if you have many fonts. In general, WYSIWYG
2261 candidate display can be a bit slower than non-WYSIWYG.
2262
2263 The display size of the candidates has no effect on the new frame
2264 font. The nominal font size for the frame is unchanged from its
2265 current value, but the actual size can change because different fonts
2266 with the same nominal sizes can appear differently.
2267
2268 Since completion is lax here, you can always edit the PIXELS or HEIGHT
2269 fields to specify the font size you want. Alternatively, you can just
2270 zoom the frame font size anytime, using, e.g., library `zoom-frm.el'.
2271
2272 After changing the font for the current frame, if you want to save it
2273 as your default font, an easy way to do that is to use command
2274 `set-frame-alist-parameter-from-frame' from library `frame-cmds.el':
2275
2276 M-x set-frame-alist-parameter-from-frame
2277
2278 You are prompted for the frame alist variable to set
2279 \(e.g. `default-frame-alist') and for the frame parameter to copy from
2280 the current frame (in this case, parameter `font').
2281
2282 Finally, there are Emacs bugs (e.g. #14634) that mean that the font
2283 candidate display is not truly WYSIWYG in all cases. And there are
2284 other Emacs bugs (e.g. #14659) that mean that an invalid XLFD font
2285 name that might be usable by Emacs in some contexts raises an error
2286 for `modify-frame-parameters' (which is used here). Consequently,
2287 `icicle-font' excludes invalid XLFD font names as candidates.
2288
2289 `icicle-WYSIWYG-Completions-flag' is ignored for this command with
2290 Emacs 20.
2291
2292 This command is intended only for use in Icicle mode."
2293 (lambda (font)
2294 (if (not (and icicle-WYSIWYG-Completions-flag (> emacs-major-version 20)))
2295 (condition-case err
2296 (modify-frame-parameters icicle-orig-frame (list (cons 'font font)))
2297 (error (icicle-msg-maybe-in-minibuffer (error-message-string err))))
2298 (save-match-data
2299 (let ((fnt font)
2300 (nb-used 0))
2301 (while (string-match "\\`-[^-]*" fnt)
2302 (setq nb-used (1+ nb-used)
2303 fnt (substring fnt (match-end 0))))
2304 (let* ((nb (* 2 nb-used))
2305 (extra (if (>= nb 30) "" (substring "-*-*-*-*-*-*-*-*-*-*-*-*-*-*" nb)))
2306 (full-font (format "%s%s" font extra)))
2307 ;; See Emacs bug #14659. For now, we just pass along the error message if invalid XLFD.
2308 (condition-case err
2309 (modify-frame-parameters icicle-orig-frame (list (cons 'font full-font)))
2310 (error (icicle-msg-maybe-in-minibuffer (error-message-string err))))))))) ; Action fn
2311 "Font: " ; `completing-read' args
2312 (if (> emacs-major-version 21)
2313 (let ((fonts (make-hash-table :test #'equal))
2314 (fontset-lst (fontset-list)))
2315 (setq fontset-lst (delete "-*-*-*-*-*-*-*-*-*-*-*-*-fontset-default" fontset-lst))
2316 (dolist (ft (append fontset-lst (x-list-fonts "*")) fonts)
2317 (puthash (or (icicle-WYSIWYG-font ft) ft) t fonts)))
2318 (let ((fonts ()))
2319 (dolist (ft (append (fontset-list) (x-list-fonts "*")) fonts)
2320 (pushnew (or (icicle-WYSIWYG-font ft) ft) fonts :test #'equal))
2321 (setq fonts (mapcar #'list fonts))))
2322 nil nil nil (if (boundp 'font-name-history) 'font-name-history 'icicle-font-name-history) nil nil
2323 ((icicle-orig-frame (selected-frame)) ; Bindings
2324 (icicle-orig-font (frame-parameter nil 'font))
2325 (icicle-orig-pixelsize (aref (x-decompose-font-name icicle-orig-font)
2326 xlfd-regexp-pixelsize-subnum))
2327 (icicle-orig-pointsize (aref (x-decompose-font-name icicle-orig-font)
2328 xlfd-regexp-pointsize-subnum))
2329 (icicle-orig-menu-bar (assq 'menu-bar-lines (frame-parameters icicle-orig-frame))))
2330 ;; First code - remove menu-bar, to avoid Emacs bug that resizes frame.
2331 (modify-frame-parameters icicle-orig-frame (list '(menu-bar-lines . 0)))
2332 (modify-frame-parameters icicle-orig-frame ; Undo code.
2333 (list (cons 'font icicle-orig-font) icicle-orig-menu-bar))
2334 (modify-frame-parameters icicle-orig-frame (list icicle-orig-menu-bar))) ; Last code.
2335
2336 (defun icicle-WYSIWYG-font (font)
2337 "Return FONT, propertized to appear in that FONT.
2338 FONT must be an XLFD string. Only the first 6 fields are used; the
2339 last 8 fields are dropped from the returned string.
2340
2341 If option `icicle-WYSIWYG-Completions-flag' is nil, just return nil.
2342
2343 A help string text property is added to the string, with the
2344 `font-info', except for the first two items (OPENED-NAME and
2345 FULL-NAME)."
2346 (and (and icicle-WYSIWYG-Completions-flag (> emacs-major-version 20))
2347 (and (not (string-match "\\`-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]-[*]\\'" font))
2348 (let* ((font-error nil)
2349 (font-info (and (or (> icicle-help-in-mode-line-delay 0) ; Only if user will see it.
2350 (and (boundp 'tooltip-mode) tooltip-mode))
2351 (condition-case nil
2352 (font-info font)
2353 (error (setq font-error t) nil))))
2354 (iii (if (< emacs-major-version 21) 3 2))
2355 (help-string (cond (font-error "Font is invalid")
2356 (font-info
2357 (format
2358 "pixelsize: %s, pixelheight: %s, offset: %s, compose: %s, ascent: %s"
2359 (aref font-info iii) (aref font-info (+ iii 1))
2360 (aref font-info (+ iii 2)) (aref font-info (+ iii 3))
2361 (aref font-info (+ iii 4))))
2362 (t "Font is not yet loaded (used)"))))
2363 (let* ((splits (split-string font "-"))
2364 (foundry (nth 1 splits))
2365 (family (nth 2 splits))
2366 (weight (nth 3 splits))
2367 (slant (nth 4 splits))
2368 (width (nth 5 splits))
2369 (style (nth 6 splits)))
2370 (icicle-candidate-short-help
2371 help-string
2372 ;; If it were not for Emacs bug #14634, just `:font' should be enough.
2373 (icicle-propertize
2374 font 'face (list :font font :foundry foundry :family family :weight weight
2375 :slant slant :width width :style style :height 100)))))))) ; 10 points
2376
2377 ;;; ;; No longer used.
2378 ;;; ;; Free var here: `icicle-orig-pixelsize' is bound in `icicle-font'.
2379 ;;; (defun icicle-font-w-orig-size (font)
2380 ;;; "Return a font like FONT, but with pixel size `icicle-orig-pixelsize'.
2381 ;;; Return nil if `x-decompose-font-name' returns nil for FONT.
2382 ;;; `icicle-orig-pixelsize' is the original pixel size for `icicle-font'."
2383 ;;; (let ((xlfd-fields (x-decompose-font-name font)))
2384 ;;; (if (not xlfd-fields) ; Can't handle such font names - return nil.
2385 ;;; nil
2386 ;;; (aset xlfd-fields xlfd-regexp-pixelsize-subnum icicle-orig-pixelsize)
2387 ;;; (aset xlfd-fields xlfd-regexp-pointsize-subnum icicle-orig-pointsize)
2388 ;;; (let* ((sized-font (x-compose-font-name xlfd-fields))
2389 ;;; (font-info (and (or (> icicle-help-in-mode-line-delay 0) ; Only if user will see it.
2390 ;;; (and (boundp 'tooltip-mode) tooltip-mode))
2391 ;;; (font-info sized-font)))
2392 ;;; (iii (if (< emacs-major-version 21) 3 2))
2393 ;;; (help-string (if font-info
2394 ;;; (format "width: %s, height: %s, offset: %s, compose: %s"
2395 ;;; (aref font-info iii) (aref font-info (+ iii 1))
2396 ;;; (aref font-info (+ iii 2)) (aref font-info (+ iii 3)))
2397 ;;; "Font is not yet loaded (used)")))
2398 ;;; (icicle-candidate-short-help help-string sized-font)
2399 ;;; (list sized-font)))))
2400
2401
2402 (when (> emacs-major-version 21) ; Need cadr of `font-lock-keywords' to hold uncompiled version.
2403
2404 (defun icicle-next-font-lock-keywords (increment &optional startoverp resetp msgp)
2405 "Cycle to the next part of `font-lock-keywords'.
2406 With a plain prefix arg (`C-u'), start over from the beginning.
2407 With a zero prefix arg, reset to the original (full) set of
2408 `font-lock-keywords'.
2409
2410 This command is mainly for testing `font-lock-keywords' patterns that
2411 you have created.
2412
2413 For more flexibility, use multi-command `icicle-font-lock-keyword'."
2414 (interactive (let ((startovr (consp current-prefix-arg))
2415 (reset (zerop (prefix-numeric-value current-prefix-arg))))
2416 (list (if startovr 1 (prefix-numeric-value current-prefix-arg))
2417 startovr
2418 reset
2419 'MSGP)))
2420 (unless icicle-orig-font-lock-keywords (setq icicle-orig-font-lock-keywords font-lock-keywords))
2421 (let ((keywds (if (eq t (car icicle-orig-font-lock-keywords))
2422 (cadr icicle-orig-font-lock-keywords)
2423 icicle-orig-font-lock-keywords)))
2424 (cond (resetp
2425 (setq font-lock-keywords icicle-orig-font-lock-keywords)
2426 (when msgp (message "`font-lock-keywords' reset to original in this buffer (full)")))
2427 (t
2428 (setq icicle-current-font-lock-part
2429 (if startoverp
2430 (car keywds)
2431 (let ((index (icicle-list-position icicle-current-font-lock-part keywds)))
2432 (if index
2433 (nth (mod (+ increment index) (length keywds)) keywds)
2434 (car keywds)))))
2435 (setq font-lock-keywords (list icicle-current-font-lock-part))
2436 (when msgp (message "`font-lock-keywords' set to next part")))))
2437 (funcall font-lock-fontify-buffer-function))
2438
2439 (defun icicle-next-font-lock-keywords-repeat (increment &optional startoverp resetp msgp) ; `M-o n'
2440 "Cycle to the next part of `font-lock-keywords'.
2441 With a plain prefix arg (`C-u'), start over from the beginning.
2442 With a zero prefix arg, reset to the original (full) set of
2443 `font-lock-keywords'.
2444
2445 This command is mainly for testing `font-lock-keywords' patterns that
2446 you have created.
2447
2448 For more flexibility, use multi-command `icicle-font-lock-keyword'."
2449 (interactive (let ((startovr (consp current-prefix-arg))
2450 (reset (zerop (prefix-numeric-value current-prefix-arg))))
2451 (list (if startovr 1 (prefix-numeric-value current-prefix-arg))
2452 startovr
2453 reset
2454 'MSGP)))
2455 (require 'repeat)
2456 (icicle-repeat-command 'icicle-next-font-lock-keywords))
2457
2458 (icicle-define-command icicle-font-lock-keyword
2459 "Choose one or more items from `font-lock-keywords'.
2460 To set `font-lock-keywords' to *all* of the keywords that currently
2461 match your input, use `M-!'. The current completions sort order is
2462 used.
2463
2464 To add *all* of the keywords that currently match your input to
2465 `font-lock-keywords', use `M-|'. The current completions sort order
2466 is used.
2467
2468 To reset the keywords to what they were originally in this
2469 buffer (e.g., before invoking `icicle-font-lock-keyword'), use a
2470 negative prefix arg when acting on any candidate (which candidate does
2471 not matter).
2472
2473 This command is mainly for testing `font-lock-keywords' patterns that
2474 you have created."
2475 (lambda (choice) ; Action function.
2476 (with-current-buffer icicle-orig-buff
2477 (cond ((and current-prefix-arg (< (prefix-numeric-value current-prefix-arg) 0))
2478 (setq font-lock-keywords icicle-orig-font-lock-keywords)
2479 (funcall font-lock-fontify-buffer-function)
2480 (message "`font-lock-keywords' reset to original (full)")
2481 (icicle-top-level))
2482 (t
2483 (setq font-lock-keywords (list (cdr (assoc choice alist)))) ; ALIST is FREE HERE.
2484 (funcall font-lock-fontify-buffer-function)
2485 (message "`font-lock-keywords' set to chosen candidate")))))
2486 "Font-lock part: " alist nil t nil nil nil nil ; `completing-read' arguments.
2487 ((icicle-sort-comparer nil)
2488 (IGNORE (unless icicle-orig-font-lock-keywords
2489 (with-current-buffer icicle-orig-buff
2490 (setq icicle-orig-font-lock-keywords font-lock-keywords))))
2491 (uncompiled-keywds (if (eq t (car icicle-orig-font-lock-keywords))
2492 (cadr icicle-orig-font-lock-keywords)
2493 icicle-orig-font-lock-keywords))
2494 (alist (delq nil (mapcar (lambda (part)
2495 (and (not (eq t part))
2496 (cons (format "%s" part) part)))
2497 uncompiled-keywds)))
2498 (icicle-all-candidates-list-action-fn `(lambda (cands)
2499 (icicle-update-f-l-keywords cands ',alist))) ; `M-!'
2500 (icicle-all-candidates-list-alt-action-fn `(lambda (cands)
2501 (icicle-update-f-l-keywords cands ',alist 'ADD)))) ; `M-|'
2502 nil nil nil) ; First, undo, last code.
2503
2504 (defun icicle-update-f-l-keywords (candidates alist &optional addp)
2505 "Set `font-lock-keywords' to the keywords represented by CANDIDATES.
2506 Non-nil ADDP means append those keywords to `font-lock-keywords'.
2507 ALIST is the (uncompiled) original (full) set of keywords for this
2508 buffer."
2509 (with-current-buffer icicle-orig-buff
2510 (let ((new-keywds (mapcar (lambda (cand) (cdr (assoc cand alist))) candidates))
2511 (uncompiled-keywds (if (eq t (car font-lock-keywords))
2512 (cadr font-lock-keywords)
2513 font-lock-keywords)))
2514 (setq font-lock-keywords (if addp (append uncompiled-keywds new-keywds) new-keywds))
2515 (funcall font-lock-fontify-buffer-function)
2516 (message (if addp
2517 "All candidates appended to `font-lock-keywords'")
2518 "`font-lock-keywords' set to all candidates"))))
2519 )
2520
2521 ;; The name of this command is quite unfortunate. It must have this name, since we use
2522 ;; `icicle-functions-to-redefine' to switch between vanilla `complete' and this.
2523 ;;
2524 (defun icicle-complete (&optional arg)
2525 "Complete the name before point.
2526 This has an effect only when `dynamic-completion-mode' is on. That
2527 mode is defined in Emacs library `completion.el'. To use this
2528 command, enter Icicle mode after turning on `dynamic-completion-mode'.
2529
2530 If option `icicle-cmpl-max-candidates-to-cycle' is non-negative
2531 integer M, and if there are at least M completion candidates, then use
2532 Icicles minibuffer completion to choose one. The text before point is
2533 treated as a prefix to match, but you can of course use progressive
2534 completion to then match also substrings or other regexps.
2535
2536 Icicles minibuffer completion is also used regardless of the value of
2537 `icicle-cmpl-max-candidates-to-cycle', if you use two or more plain
2538 prefix args (`C-u C-u').
2539
2540 Otherwise, consecutive calls cycle through the possible completions,
2541 in place. This is the vanilla `complete' command behavior from
2542 library `completion.el'.
2543
2544 Point is normally left at the end of the inserted completion.
2545
2546 Prefix arg behavior:
2547
2548 Odd number of `C-u': Leave point at start, not end, of completion.
2549
2550 More than one `C-u': Use Icicles minibuffer completion.
2551
2552 An integer N : Use Nth next completion (previous Nth if N < 0).
2553 `-' : Same as -1: previous completion.
2554
2555 If option `icicle-cmpl-include-cdabbrev-flag' is non-nil then Icicles
2556 completion includes candidates found dynamically from the currently
2557 available windows. These candidates are highlighted in buffer
2558 `*Completions*' using face `icicle-special-candidate' so you can
2559 easily distinguish them.
2560
2561 This is the so-called `CDABBREV' completion method defined in
2562 `completion.el'. It is similar to how `dabbrev' finds candidates but
2563 with these differences:
2564 * It is sometimes faster, since it does not use regexps. It searches
2565 backwards looking for names that start with the text before point.
2566 * Case-sensitivity is handled as for other `completion.el' completion.
2567
2568 If Icicles completion is not used then this `CDABBREV' completion is
2569 used only when no matching completions are found in the completions
2570 database. With Icicles completion you can immediately choose one of
2571 the `CDABBREV' candidates.
2572
2573 During Icicles minibuffer completion you can use `S-delete' to remove
2574 the current completion candidate from the database of completions.
2575 Cycle among the candidates (e.g. `down'), and use `S-delete' to delete
2576 as many as you want.
2577
2578 \(You can also delete any database entry using `\\[kill-completion]'.
2579 And you can add a database entry using `\\[add-completion]'.)
2580
2581 See the comments at the top of `completion.el' for more info."
2582 (interactive "*p")
2583 (let ((buf-modified-p (buffer-modified-p))
2584 (icicle-sort-comparer nil)
2585 (icicle-sort-orders-alist
2586 '(("by last dynamic completion") ; Renamed from "turned OFF'.
2587 ("cdabbrev candidates first" . icicle-special-candidates-first-p)
2588 ("alphabetical" . icicle-case-string-less-p)
2589 ("by last use as input" . icicle-latest-input-first-p)
2590 ("by previous input use alphabetically" . icicle-historical-alphabetic-p))))
2591 (cond ((eq last-command this-command)
2592 (delete-region cmpl-last-insert-location (point)) ; Undo last one
2593 (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))) ; Get next completion
2594 (t
2595 (unless cmpl-initialized-p (completion-initialize)) ; Make sure everything is loaded
2596 (if (and (consp current-prefix-arg) (eq (logand (length current-prefix-arg) 1) 1)) ; `oddp'
2597 (setq cmpl-leave-point-at-start t
2598 arg 0)
2599 (setq cmpl-leave-point-at-start nil))
2600 (setq cmpl-original-string (symbol-before-point-for-complete))
2601 (unless cmpl-original-string
2602 (setq this-command 'failed-complete)
2603 (error "To complete, point must be after a symbol at least %d chars long"
2604 completion-prefix-min-length))
2605 (setq cmpl-current-index (if current-prefix-arg arg 0))
2606 (completion-search-reset cmpl-original-string) ; Reset database
2607 (delete-region cmpl-symbol-start cmpl-symbol-end))) ; Erase what we've got
2608 (let* ((num-comps 0)
2609 (db-comps ())
2610 (db-comps (progn (mapatoms (lambda (sy)
2611 (when (eq 0 (string-match cmpl-test-regexp (symbol-name sy)))
2612 (push (find-exact-completion (symbol-name sy)) db-comps)
2613 (setq num-comps (1+ num-comps))))
2614 cmpl-obarray)
2615 db-comps))
2616 (all-comps db-comps)
2617 (all-comps (if (not icicle-cmpl-include-cdabbrev-flag)
2618 db-comps
2619 (unless cmpl-cdabbrev-reset-p
2620 (reset-cdabbrev cmpl-test-string cmpl-tried-list)
2621 (setq cmpl-cdabbrev-reset-p t))
2622 (let ((next nil))
2623 (while (and (setq next (next-cdabbrev))
2624 (not (assoc next db-comps))) ; Not in database
2625 (put-text-property 0 (length next) 'face 'icicle-special-candidate next)
2626 (push (list next) all-comps)
2627 (setq num-comps (1+ num-comps)))
2628 all-comps)))
2629 (use-icicles-p (or (and (consp current-prefix-arg) ; `C-u C-u...' (more than one)
2630 (> (prefix-numeric-value current-prefix-arg) 4)
2631 (> num-comps 1))
2632 (and icicle-cmpl-max-candidates-to-cycle
2633 (> num-comps (max 1 icicle-cmpl-max-candidates-to-cycle)))))
2634 (print-status-p (and (>= baud-rate completion-prompt-speed-threshold)
2635 (not (window-minibuffer-p))))
2636 (insert-point (point))
2637 (entry (if use-icicles-p
2638 (condition-case nil
2639 (let ((completion-ignore-case t)
2640 (icicle-show-Completions-initially-flag t)
2641 (icicle-delete-candidate-object 'delete-completion))
2642 (completing-read "Completion: " all-comps nil t cmpl-original-string))
2643 (quit nil)) ; Return nil, so deleted original prefix will be re-inserted.
2644 (completion-search-next cmpl-current-index))) ; Cycle to next.
2645 string)
2646 ;; If ENTRY is non-nil, it is a full completion entry or a string (if cdabbrev or if USE-ICICLES-P).
2647 (cond (entry ; Found, so insert it.
2648 (setq string (if (stringp entry) entry (completion-string entry)) ; Use proper case
2649 string (cmpl-merge-string-cases string cmpl-original-string))
2650 (insert string)
2651 (setq completion-to-accept string)
2652 (if (not cmpl-leave-point-at-start) ; Fix-up and cache point
2653 (setq cmpl-last-insert-location insert-point) ; Point at end.
2654 (setq cmpl-last-insert-location (point))
2655 (goto-char insert-point))
2656 (unless use-icicles-p ; Display the next completion
2657 (cond ((and print-status-p
2658 (sit-for 0) ; Update the display. Print only if there is no typeahead.
2659 (setq entry (completion-search-peek completion-cdabbrev-prompt-flag)))
2660 (setq string (if (stringp entry) entry (completion-string entry))
2661 string (cmpl-merge-string-cases string cmpl-original-string))
2662 (message "Next completion: `%s'" string)))))
2663 (t ; No completion found, so re-insert original.
2664 (insert cmpl-original-string)
2665 (set-buffer-modified-p buf-modified-p)
2666 (setq completion-to-accept nil) ; Do not accept completions.
2667 (when (and print-status-p (sit-for 0))
2668 (message "No %scompletions" (if (eq this-command last-command) "more " "")))
2669 (setq this-command 'failed-complete)))))) ; Pretend that we were never here
2670
2671
2672 (defvar icicle-info-buff nil
2673 "Info buffer before command was invoked.")
2674
2675 (defvar icicle-info-window nil
2676 "Info window before command was invoked.")
2677
2678 (defun icicle-Info-index (&optional topic)
2679 "Like vanilla `Info-index', but you can use multi-command keys `C-RET', `C-up' etc.
2680 Also, for Emacs 22 and later:
2681 Completion candidates (index topics) for nodes you have already
2682 visited may be highlighted automatically with face
2683 `icicle-historical-candidate-other', depending on the value of option
2684 `icicle-Info-highlight-visited-nodes'. You can always effect such
2685 highlighting on demand, using `C-M-l'."
2686 ;; We allow an arg only for non-interactive use. E.g., `Info-virtual-index' calls (Info-index TOPIC).
2687 (interactive)
2688 (unless (and (featurep 'info) (eq major-mode 'Info-mode))
2689 (icicle-user-error "You must be in Info mode to use this command"))
2690 (when (and (boundp 'Info-current-file) (equal Info-current-file "dir"))
2691 (icicle-user-error "The Info directory node has no index; use `m' to select a manual"))
2692 (let ((icicle-info-buff (current-buffer))
2693 (icicle-info-window (selected-window))
2694 (icicle-candidate-action-fn 'icicle-Info-index-action)
2695 (C-x-m (lookup-key minibuffer-local-completion-map "\C-xm"))
2696 ;; These next 3 are used as FREE vars
2697 ;; in `icicle-Info-node-is-indexed-by-topic' and `icicle-display-candidates-in-Completions'
2698 (icicle-Info-index-nodes (and (fboundp 'Info-index-nodes) (Info-index-nodes))) ; Emacs 22+
2699 (icicle-Info-manual Info-current-file)
2700 (icicle-Info-hist-list (and (boundp 'Info-history-list) Info-history-list)) ; Emacs 22+
2701 (icicle-transform-function 'icicle-remove-duplicates)) ; See Emacs bug #12705.
2702 (when (and (require 'bookmark+ nil t) (fboundp 'icicle-bookmark-info-other-window))
2703 (define-key minibuffer-local-completion-map (icicle-kbd "C-x m")
2704 'icicle-bookmark-info-other-window))
2705 (unwind-protect
2706 (if topic
2707 (icicle-ORIG-Info-index topic)
2708 (call-interactively (if (> emacs-major-version 21) 'icicle-ORIG-Info-index 'icicle-Info-index-20)))
2709 (define-key minibuffer-local-completion-map (icicle-kbd "C-x m") C-x-m))))
2710
2711 ;; Thx to Tamas Patrovics for this Emacs 20 version.
2712 ;;
2713 (defun icicle-Info-index-20 ()
2714 "Like `Info-index', but you can use completion for the index topic."
2715 (interactive)
2716 (let* ((symb (or (and (fboundp 'symbol-nearest-point) ; `icicles-opt.el' soft-requires `thingatpt+.el'.
2717 (symbol-nearest-point))
2718 (symbol-at-point)))
2719 (topic (and symb (symbol-name symb))))
2720 (icicle-ORIG-Info-index "")
2721 (let ((pattern "\\* +\\([^:]*\\):.")
2722 (candidates ()))
2723 (goto-char (point-min))
2724 (while (re-search-forward pattern nil t) (push (list (match-string 1)) candidates))
2725 (icicle-ORIG-Info-index (completing-read "Index topic: " candidates nil t nil nil topic)))))
2726
2727 ;; Free vars here: `icicle-info-buff' and `icicle-info-window' are bound in `icicle-Info-index'.
2728 (defun icicle-Info-index-action (topic)
2729 "Completion action function for `icicle-Info-index'."
2730 (let ((minibuf-win (selected-window)))
2731 (set-buffer icicle-info-buff)
2732 (select-window icicle-info-window)
2733 (icicle-ORIG-Info-index topic)
2734 (select-window minibuf-win)))
2735
2736 (defun icicle-Info-menu (&optional menu-item fork)
2737 "Go to a menu node.
2738 See `icicle-ORIG-Info-menu'."
2739 (interactive)
2740 (if menu-item
2741 (if (< emacs-major-version 21)
2742 (icicle-ORIG-Info-menu menu-item)
2743 (icicle-ORIG-Info-menu menu-item fork))
2744 (call-interactively #'icicle-Info-menu-cmd)))
2745
2746 ;; Free vars here: `Info-menu-entry-name-re' is bound in `info.el'.
2747 (icicle-define-command icicle-Info-menu-cmd
2748 "Go to an Info menu node." ; Doc string
2749 (lambda (m)
2750 (icicle-Info-goto-node-no-search (cdr (funcall icicle-get-alist-candidate-function m)))) ; Action
2751 "Menu item: " icicle-candidates-alist ; `completing-read' args
2752 nil t nil nil (save-excursion
2753 (goto-char (point-min))
2754 (unless (search-forward "\n* menu:" nil t) (icicle-user-error "No menu in this node"))
2755 (setq menu-eol (point))
2756 (and (< menu-eol opoint)
2757 (save-excursion
2758 (goto-char opoint) (end-of-line)
2759 (and (re-search-backward (concat "\n\\* +\\("
2760 (if (boundp 'Info-menu-entry-name-re)
2761 Info-menu-entry-name-re
2762 "[^:\t\n]*")
2763 "\\):")
2764 menu-eol t)
2765 (match-string-no-properties 1)))))
2766 nil
2767 ((opoint (point)) ; Bindings
2768 (completion-ignore-case t)
2769 (case-fold-search t)
2770 (icicle-sort-comparer nil)
2771 (icicle-whole-candidate-as-text-prop-p t)
2772 (Info-complete-menu-buffer (current-buffer))
2773 (icicle-candidates-alist (mapcar (lambda (m) (cons m (Info-extract-menu-item m)))
2774 (reverse (all-completions "" 'Info-complete-menu-item))))
2775 menu-eol))
2776
2777 (defun icicle-Info-goto-node-no-search (nodename &optional arg)
2778 "Go to Info node named NODENAME.
2779 Completion is available for node names in the current Info file.
2780
2781 With a prefix argument:
2782
2783 * Plain `C-u' means prepend the current Info file name (manual name)
2784 to each node name. For example: `(emacs)Paragraphs' instead of
2785 just `Paragraphs'.
2786
2787 * A negative numeric prefix arg (e.g. `C--') means present candidate
2788 nodes in book order, and limit them to the current node and the
2789 nodes in the rest of the book following it. In this case, the
2790 first candidate is `..', which means go up.
2791
2792 * A non-negative numeric prefix arg (e.g. `C-1') means show the
2793 target node in a new Info buffer (not available prior to Emacs 21).
2794
2795 With no prefix argument, or with a non-negative prefix arg, you can
2796 use `C-,' to choose how to sort completion candidates. By default,
2797 they are sorted alphabetically.
2798
2799 If you use library `Bookmark+' then you can use `C-x m' during
2800 completion to jump to Info bookmarks.
2801
2802 Input-candidate completion and cycling are available. While cycling,
2803 these keys with prefix `C-' are active:
2804
2805 `C-mouse-2', `C-RET' - Go to current completion candidate (node)
2806 `C-down' - Go to next completion candidate
2807 `C-up' - Go to previous completion candidate
2808 `C-next' - Go to next apropos-completion candidate
2809 `C-prior' - Go to previous apropos-completion candidate
2810 `C-end' - Go to next prefix-completion candidate
2811 `C-home' - Go to previous prefix-completion candidate
2812
2813 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or
2814 `C-g' to quit.
2815
2816 This is an Icicles command - see command `icicle-mode'.
2817
2818 From Lisp code:
2819
2820 Argument NODENAME has the form NODE or (FILE)NODE-IN-FILE, where:
2821
2822 NODE names a node in the current Info file or one of its subfiles.
2823 FILE names an Info file containing node NODE-IN-FILE.
2824
2825 If optional argument ARG is a string, then show the node in a new
2826 Info buffer named `*info-ARG*'."
2827 (interactive
2828 (let* ((icicle-info-buff (current-buffer))
2829 (icicle-info-window (selected-window))
2830 (icicle-candidate-action-fn 'icicle-Info-goto-node-action)
2831 (icicle-pref-arg current-prefix-arg)
2832 (icicle-Info-only-rest-of-book-p (< (prefix-numeric-value current-prefix-arg) 0))
2833 (icicle-sort-orders-alist (cons '("in book order") icicle-sort-orders-alist))
2834 (icicle-sort-comparer (and (not icicle-Info-only-rest-of-book-p)
2835 icicle-sort-comparer)))
2836 (list (icicle-Info-read-node-name "Go to node: " (consp current-prefix-arg))
2837 current-prefix-arg)))
2838 (icicle-Info-goto-node-1 nodename arg))
2839
2840 (defun icicle-Info-goto-node-1 (nodename &optional arg)
2841 "Same as vanilla `Info-goto-node', but go up for `..' pseudo-node."
2842 (if (and (string= nodename "..") (Info-check-pointer "up"))
2843 (Info-up)
2844 (if (> emacs-major-version 20)
2845 (icicle-ORIG-Info-goto-node nodename (natnump arg))
2846 (icicle-ORIG-Info-goto-node nodename))))
2847
2848 (defun icicle-Info-read-node-name (prompt &optional include-file-p)
2849 "Read an Info node name, prompting with PROMPT.
2850 Non-nil optional arg INCLUDE-FILE-P means include current Info file in
2851 the name."
2852 (let ((C-x-m (lookup-key minibuffer-local-completion-map "\C-xm")))
2853 (when (and (require 'bookmark+ nil t) (fboundp 'icicle-bookmark-info-other-window))
2854 (define-key minibuffer-local-completion-map (icicle-kbd "C-x m")
2855 'icicle-bookmark-info-other-window))
2856 (unwind-protect
2857 (let* ((completion-ignore-case t)
2858 (Info-read-node-completion-table (icicle-Info-build-node-completions include-file-p))
2859 (nodename (completing-read prompt 'Info-read-node-name-1 nil nil)))
2860 (if (equal nodename "")
2861 (icicle-Info-read-node-name prompt include-file-p) ; Empty input - read again.
2862 nodename))
2863 (define-key minibuffer-local-completion-map (icicle-kbd "C-x m") C-x-m))))
2864
2865 (defun icicle-Info-build-node-completions (&optional include-file-p)
2866 "Build completions list for Info nodes.
2867 This takes `icicle-Info-only-rest-of-book-p' into account.
2868 Non-nil INCLUDE-FILE-P means include current Info file in the name."
2869 (icicle-highlight-lighter)
2870 (if (or (not icicle-Info-only-rest-of-book-p) (string= Info-current-node "Top"))
2871 (icicle-Info-build-node-completions-1 include-file-p)
2872 (cons '("..") (member (list Info-current-node) (icicle-Info-build-node-completions-1 include-file-p)))))
2873
2874 (defun icicle-Info-build-node-completions-1 (&optional include-file-p)
2875 "Helper function for `icicle-Info-build-node-completions'.
2876 Use `Info-build-node-completions' to build node list for completion.
2877 Non-nil INCLUDE-FILE-P means include current Info file in the name.
2878 Remove pseudo-node `*'. (This just fixes a bug in Emacs 21 and 22.1.)"
2879 (let ((comps (Info-build-node-completions)))
2880 ;; Emacs 24 after 2012-12-18: `Info-build-node-completions' no longer reverses the node order.
2881 (when (or (< emacs-major-version 24) (and (= emacs-major-version 24) (< emacs-minor-version 3)))
2882 (setq comps (reverse comps)))
2883 (when (equal (car comps) '("*")) (setq comps (cdr comps)))
2884 (if include-file-p
2885 (let ((file (concat "(" (cond ((stringp Info-current-file)
2886 (replace-regexp-in-string
2887 "%" "%%" (file-name-nondirectory Info-current-file)))
2888 (Info-current-file (format "*%S*" Info-current-file))
2889 (t ""))
2890 ")")))
2891 (mapcar (lambda (node) (cons (concat file (car node)) (cdr node))) comps))
2892 comps)))
2893
2894 ;; Free vars here:
2895 ;; `icicle-info-buff' and `icicle-info-window' are bound in `icicle-Info-goto-node(-no-search|of-content)'.
2896 ;; `Info-read-node-completion-table' is bound in `info.el'.
2897 (defun icicle-Info-goto-node-action (node)
2898 "Completion action function for `icicle-Info-goto-node'."
2899 (set-buffer icicle-info-buff)
2900 (select-window icicle-info-window)
2901 (icicle-Info-goto-node-1 node icicle-pref-arg)
2902 (when icicle-Info-only-rest-of-book-p
2903 (setq Info-read-node-completion-table (icicle-Info-build-node-completions)
2904 icicle-current-input "")
2905 (icicle-complete-again-update)
2906 (if (and (string= Info-current-node "Top") Info-history)
2907 (let* ((hist Info-history)
2908 (last (cadr (car hist))))
2909 (while (string= "Top" (cadr (car hist))) (pop hist))
2910 (setq icicle-candidate-nb
2911 (1- (length (member (list (cadr (car hist)))
2912 (icicle-Info-build-node-completions-1))))))
2913 (setq icicle-candidate-nb 1)) ; Skip `..'.
2914
2915 ;; $$$$$$ Maybe factor this out. Same thing in several places. However, here we don't do
2916 ;; `icicle-maybe-sort-and-strip-candidates' at beginning of first clause.
2917 (cond ((and icicle-completion-candidates (cdr icicle-completion-candidates)) ; > 1 left.
2918 (message "Displaying completion candidates...")
2919 (save-selected-window (icicle-display-candidates-in-Completions))
2920 (with-current-buffer "*Completions*"
2921 (goto-char (icicle-start-of-candidates-in-Completions))
2922 (icicle-move-to-next-completion
2923 (mod icicle-candidate-nb (length icicle-completion-candidates)))
2924 (set-window-point (get-buffer-window "*Completions*" 0) (point))
2925 (setq icicle-last-completion-candidate (icicle-current-completion-in-Completions))
2926 (set-buffer-modified-p nil)))
2927 (icicle-completion-candidates ; Single candidate left
2928 (save-selected-window (icicle-remove-Completions-window))
2929 (let ((completion (icicle-transform-multi-completion
2930 (car icicle-completion-candidates))))
2931 (select-window (active-minibuffer-window))
2932 (with-current-buffer (window-buffer) ; Need if `*Completions*' redirected to minibuffer.
2933 (goto-char (icicle-minibuffer-prompt-end))
2934 (icicle-clear-minibuffer)
2935 (insert (if (and (icicle-file-name-input-p)
2936 insert-default-directory
2937 (or (not (member completion icicle-extra-candidates))
2938 icicle-extra-candidates-dir-insert-p))
2939 (icicle-file-name-directory-w-default icicle-current-input)
2940 "")
2941 completion))))
2942 (t ; No candidates left
2943 (select-window (active-minibuffer-window))
2944 (with-current-buffer (window-buffer) ; Needed if `*Completions*' redirected to minibuffer.
2945 (goto-char (icicle-minibuffer-prompt-end))
2946 (icicle-clear-minibuffer)))))
2947 (select-window (active-minibuffer-window))
2948 (select-frame-set-input-focus (selected-frame)))
2949
2950 (when (fboundp 'clone-buffer) ; Emacs 22+
2951 (defun icicle-Info-goto-node-of-content (nodename &optional arg)
2952 "Go to Info node whose node name or content matches your input.
2953 Candidate node names are those in the current Info file.
2954
2955 With a prefix argument:
2956
2957 * Plain `C-u' means prepend the current Info file name (manual name)
2958 to each node name. For example: `(emacs)Paragraphs' instead of
2959 just `Paragraphs'.
2960
2961 * A negative numeric prefix arg (e.g. `C--') means present candidate
2962 nodes in book order, and limit them to the current node and the
2963 nodes in the rest of the book following it. In this case, the
2964 first candidate is `..', which means go up.
2965
2966 * A non-negative numeric prefix arg (e.g. `C-1') means show the
2967 target node in a new Info buffer.
2968
2969 With no prefix argument, or with a non-negative prefix arg, you can
2970 use `C-,' to choose how to sort completion candidates (node names).
2971 By default, they are sorted alphabetically.
2972
2973 Completion candidates are two-part multi-completions, with the second
2974 part optional. If both parts are present they are separated by
2975 `icicle-list-join-string' (\"^G^J\", by default).
2976
2977 The first part is matched as a regexp against a node name. The second
2978 part is matched as a regexp against the node content. Candidates that
2979 do not match are filtered out.
2980
2981 When matching node content, Icicles just looks for a single match.
2982 Visiting the node does not move to that match or to any other match.
2983 Matching is used only to filter candidate files.
2984
2985 However, if your input includes a content-matching part and it
2986 matches, that part is automatically added to the Isearch regexp
2987 history, `regexp-search-ring' whenever you hit `S-TAB' to complete.
2988 This means that when you visit the node you can immediately search for
2989 matches using `C-M-s' or `C-M-r'.
2990
2991 Your minibuffer input can match a node name or content, or both. Use
2992 `C-M-j' (equivalent here to `C-q C-g C-j') to input the default
2993 separator.
2994
2995 For example:
2996
2997 To match `foo' against node names, use input `foo'.
2998 To match `bar' against node contents, use input `C-M-j bar'.
2999 To match both names and content, use input `foo C-M-j bar'.
3000
3001 Only the matching node names are shown in buffer `*Completions*', and
3002 only the chosen name is returned. The actual content matches are
3003 unimportant anyway: content matching is used only to filter the
3004 candidates.
3005
3006 If your input does not include a content-matching part then this
3007 command acts similar to `icicle-Info-goto-node-no-search'.
3008
3009 If your input includes a content-matching part then all nodes matching
3010 the name part of your input (or all, if no name part) are searched.
3011 As you would expect, content matching can be costly in time, even
3012 though it can be quite helpful. Use name matching to narrow the set
3013 of nodes that must be visited to search their contents.
3014
3015 If you use library `Bookmark+' then you can use `C-x m' during
3016 completion to jump to Info bookmarks.
3017
3018 Input-candidate completion and cycling are available. While cycling,
3019 these keys with prefix `C-' are active:
3020
3021 `C-mouse-2', `C-RET' - Go to current completion candidate (node)
3022 `C-down' - Go to next completion candidate
3023 `C-up' - Go to previous completion candidate
3024 `C-next' - Go to next apropos-completion candidate
3025 `C-prior' - Go to previous apropos-completion candidate
3026 `C-end' - Go to next prefix-completion candidate
3027 `C-home' - Go to previous prefix-completion candidate
3028
3029 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or
3030 `C-g' to quit.
3031
3032 This is an Icicles command - see command `icicle-mode'.
3033
3034 From Lisp code:
3035
3036 Argument NODENAME has the form NODE or (FILE)NODE-IN-FILE, where:
3037
3038 NODE names a node in the current Info file or one of its subfiles.
3039 FILE names an Info file containing node NODE-IN-FILE.
3040
3041 If optional argument ARG is a string, then show the node in a new
3042 Info buffer named `*info-ARG*'."
3043 (interactive
3044 (let* ((icicle-info-buff (current-buffer))
3045 (icicle-info-window (selected-window))
3046 (icicle-candidate-action-fn 'icicle-Info-goto-node-action)
3047 (icicle-pref-arg current-prefix-arg) ; For `icicle-Info-*-action'.
3048 (icicle-Info-only-rest-of-book-p (< (prefix-numeric-value current-prefix-arg) 0))
3049 (icicle-sort-orders-alist (cons '("in book order") icicle-sort-orders-alist))
3050 (icicle-sort-comparer (and (not icicle-Info-only-rest-of-book-p)
3051 icicle-sort-comparer))
3052 (icicle-multi-completing-p t)
3053 ;; Bind `icicle-apropos-complete-match-fn' to nil to prevent automatic input matching
3054 ;; in `icicle-unsorted-apropos-candidates' etc., because `icicle-Info-multi-read-node-name'
3055 ;; does everything.
3056 (icicle-apropos-complete-match-fn nil)
3057 (icicle-last-apropos-complete-match-fn 'icicle-Info-apropos-complete-match))
3058 (list (icicle-Info-read-node-of-content "Go to node: " (consp current-prefix-arg))
3059 current-prefix-arg)))
3060 (icicle-Info-goto-node-1 nodename arg))
3061
3062 (defun icicle-Info-apropos-complete-match (input node)
3063 "Match fn for progressive completion with `icicle-Info-goto-node-of-content'.
3064 Return non-nil if the current multi-completion INPUT matches NODE.
3065 NODE is an Info node name.
3066 If INPUT contains a content-matching part then it too must match."
3067 (lexical-let* ((node-pat (let ((icicle-list-use-nth-parts '(1)))
3068 (icicle-transform-multi-completion input)))
3069 (content-pat (let ((icicle-list-use-nth-parts '(2)))
3070 (icicle-transform-multi-completion input))))
3071 (and (icicle-string-match-p node-pat node)
3072 (or (equal "" content-pat) (icicle-Info-content-match content-pat node)))))
3073
3074 (defun icicle-Info-content-match (content-pat node)
3075 "Return non-nil if CONTENT-PAT matches content of NODE.
3076 CONTENT-PAT is a regexp. NODE is an Info node name."
3077 ;; Gross hack. If `C-u' was used then NODE has form `(FILE)NODE',
3078 ;; and we need to remove the `(FILE)', for arg to `Info-find-node'.
3079 (when (and (consp icicle-pref-arg) (string-match "^([^)]+)\\(.+\\)$" node))
3080 (setq node (match-string 1 node)))
3081 (let* ((Info-history ()) ; Do not record the node searched.
3082 (Info-history-list ())
3083 (found (with-current-buffer Info-complete-menu-buffer
3084 (when (and (string= node "..") (Info-check-pointer "up"))
3085 (setq node (Info-extract-pointer "up")))
3086 ;; `icicle-Info-tag-table-posn' FREE HERE, defined in `icicle-Info-read-node-of-content'.
3087 (set-marker Info-tag-table-marker icicle-Info-tag-table-posn)
3088 (if (and (featurep 'info+) (> emacs-major-version 21))
3089 (Info-find-node Info-current-file node 'NO-BACK 'NOMSG)
3090 (Info-find-node Info-current-file node 'NO-BACK))
3091 (goto-char (point-min))
3092 (re-search-forward content-pat nil t))))
3093 (when (and found ; Do not do it just because incrementally complete.
3094 (or (get this-command 'icicle-apropos-completing-command)
3095 (memq this-command '(icicle-retrieve-next-input icicle-retrieve-previous-input))))
3096 (isearch-update-ring content-pat 'REGEXP))
3097 found))
3098
3099 (defun icicle-Info-read-node-of-content (prompt &optional include-file-p)
3100 "Read node name and content search string, prompting with PROMPT.
3101 See `icicle-Info-goto-node-of-content' for a description of the input.
3102 Non-nil optional arg INCLUDE-FILE-P means include current Info file in
3103 the name."
3104 (let ((C-x-m (lookup-key minibuffer-local-completion-map "\C-xm"))
3105 (Info-complete-menu-buffer (clone-buffer))
3106 ;; Save the position for the current file (manual), so we can then set the (local) marker
3107 ;; to it when we visit the cloned buffer for the same file.
3108 (icicle-Info-tag-table-posn (marker-position Info-tag-table-marker)))
3109 (when (and (require 'bookmark+ nil t) (fboundp 'icicle-bookmark-info-other-window))
3110 (define-key minibuffer-local-completion-map (icicle-kbd "C-x m")
3111 'icicle-bookmark-info-other-window))
3112 (unwind-protect
3113 (let* ((completion-ignore-case t)
3114 (Info-read-node-completion-table (icicle-Info-build-node-completions include-file-p))
3115 (icicle-list-use-nth-parts '(1))
3116 (nodename (icicle-transform-multi-completion
3117 (completing-read
3118 prompt 'icicle-Info-multi-read-node-name))))
3119 (if (equal nodename "")
3120 (icicle-Info-read-node-of-content prompt include-file-p) ; Empty input - read again.
3121 nodename))
3122 (kill-buffer Info-complete-menu-buffer)
3123 (define-key minibuffer-local-completion-map (icicle-kbd "C-x m") C-x-m))))
3124
3125 ;;;; $$$$$$$$
3126 ;;;; This version is in effect what we'll use at first (it is equivalent to those below, which have
3127 ;;;; commented-out sections). It does not let users switch manuals by completing against the manual name.
3128 ;;;; It just uses the current manual.
3129 ;;;;
3130 ;;;; (defun icicle-Info-multi-read-node-name (strg pred completion-mode)
3131 ;;;; "Completion function for `icicle-Info-read-node-of-content'.
3132 ;;;; This is used as the value of `minibuffer-completion-table'."
3133 ;;;; (setq strg icicle-current-input)
3134 ;;;; (lexical-let* ((node-pat (let ((icicle-list-use-nth-parts '(1)))
3135 ;;;; (icicle-transform-multi-completion strg)))
3136 ;;;; (node-pat (if (memq icicle-current-completion-mode '(nil apropos))
3137 ;;;; node-pat
3138 ;;;; (concat "^" (regexp-quote node-pat))))
3139 ;;;; (content-pat (let ((icicle-list-use-nth-parts '(2)))
3140 ;;;; (icicle-transform-multi-completion strg)))
3141 ;;;; (nodes (mapcar #'car Info-read-node-completion-table))
3142 ;;;; (nodes (icicle-remove-if-not (lambda (nod)
3143 ;;;; (icicle-string-match-p node-pat nod))
3144 ;;;; nodes))
3145 ;;;; (nodes (if (equal "" content-pat)
3146 ;;;; nodes
3147 ;;;; (icicle-remove-if-not
3148 ;;;; `(lambda (node)
3149 ;;;; (icicle-Info-content-match ',content-pat node))
3150 ;;;; nodes))))
3151 ;;;; (cond ((and (eq 'metadata completion-mode) (> emacs-major-version 23))
3152 ;;;; '(metadata (category . info-node)))
3153 ;;;; (completion-mode nodes) ; `all-completions', `test-completion'
3154 ;;;; (t
3155 ;;;; (try-completion ; `try-completion'
3156 ;;;; strg (mapcar #'list nodes) (and pred (lambda (ss) (funcall pred ss))))))))
3157
3158 )
3159
3160 (when (fboundp 'completion-table-with-context) ; Emacs 23+.
3161 (defun icicle-Info-multi-read-node-name (strg pred completion-mode)
3162 "Completion function for `icicle-Info-read-node-of-content'.
3163 This is used as the value of `minibuffer-completion-table'."
3164 (unless strg (setq strg icicle-current-input))
3165 (if (eq 'metadata completion-mode)
3166 '(metadata (category . info-node)) ; $$$$$$ Not used currently.
3167 (cond
3168 ;;; $$$$$$ Fix and add back later. This is the vanilla Emacs approach, which loses parens.
3169 ;;; ((string-match "\\`([^)]*\\'" strg) ; Incomplete file name: `(...' - complete it.
3170 ;;; (completion-table-with-context "("
3171 ;;; (apply-partially
3172 ;;; 'completion-table-with-terminator ")"
3173 ;;; (apply-partially 'Info-read-node-name-2
3174 ;;; Info-directory-list
3175 ;;; (mapcar 'car Info-suffix-list)))
3176 ;;; (substring strg 1) pred completion-mode))
3177 ;;; ((string-match "\\`(\\([^)]+\\))" strg) ; A complete file name. Complete nodes in file.
3178 ;;; (let ((file0 (match-string 0 strg))
3179 ;;; (file1 (match-string 1 strg))
3180 ;;; (nodename (substring strg (match-end 0))))
3181 ;;; (if (and (equal nodename "") (eq completion-mode 'lambda))
3182 ;;; t ; Empty node name means "Top".
3183 ;;; (completion-table-with-context file0
3184 ;;; (apply-partially (lambda (string pred action)
3185 ;;; (complete-with-action
3186 ;;; action
3187 ;;; (Info-build-node-completions
3188 ;;; (Info-find-file file1))
3189 ;;; string pred)))
3190 ;;; nodename pred completion-mode))))
3191 (t
3192 (lexical-let* ((node-pat (let ((icicle-list-use-nth-parts '(1)))
3193 (icicle-transform-multi-completion strg)))
3194 (node-pat (if (memq icicle-current-completion-mode '(nil apropos))
3195 node-pat
3196 (concat "^" (regexp-quote node-pat))))
3197 (content-pat (let ((icicle-list-use-nth-parts '(2)))
3198 (icicle-transform-multi-completion strg)))
3199 (nodes (mapcar #'car Info-read-node-completion-table))
3200 (nodes (icicle-remove-if-not
3201 `(lambda (nod)
3202 (let ((case-fold-search t))
3203 (icicle-string-match-p ',node-pat nod)))
3204 nodes))
3205 (nodes (if (equal "" content-pat)
3206 nodes
3207 (icicle-remove-if-not
3208 `(lambda (nod) (icicle-Info-content-match ',content-pat nod))
3209 nodes))))
3210 (if completion-mode ; `all-completions', `test-completion'
3211 nodes
3212 (try-completion ; `try-completion'
3213 strg (mapcar #'list nodes) (and pred (lambda (ss) (funcall pred ss))))))))))
3214
3215 )
3216
3217 (when (= emacs-major-version 22) ; Emacs 22.
3218 (defun icicle-Info-multi-read-node-name (strg pred completion-mode)
3219 "Completion function for `icicle-Info-read-node-of-content'.
3220 This is used as the value of `minibuffer-completion-table'."
3221 (setq strg icicle-current-input)
3222 (cond
3223 ;;; $$$$$$ Fix and add back later. This is the vanilla Emacs approach, which loses parens (so broken).
3224 ;;; ((string-match "\\`([^)]*\\'" strg) ; Incomplete file name: `(...' - complete it.
3225 ;;; (let ((file (substring strg 1)))
3226 ;;; (cond ((eq completion-mode nil)
3227 ;;; (let ((comp (try-completion
3228 ;;; file 'Info-read-node-name-2 (cons Info-directory-list
3229 ;;; (mapcar 'car Info-suffix-list)))))
3230 ;;; (cond ((eq comp t) (concat strg ")"))
3231 ;;; (comp (concat "(" comp)))))
3232 ;;; ((eq completion-mode t)
3233 ;;; (all-completions file 'Info-read-node-name-2 (cons Info-directory-list
3234 ;;; (mapcar 'car Info-suffix-list))))
3235 ;;; (t nil))))
3236 ;;; ((string-match "\\`(" strg) ; A complete file name. Any node is fair game.
3237 ;;; (cond ((eq completion-mode nil) strg)
3238 ;;; ((eq completion-mode t) nil)
3239 ;;; (t t)))
3240 (t
3241 (lexical-let* ((node-pat (let ((icicle-list-use-nth-parts '(1)))
3242 (icicle-transform-multi-completion strg)))
3243 (node-pat (if (memq icicle-current-completion-mode '(nil apropos))
3244 node-pat
3245 (concat "^" (regexp-quote node-pat))))
3246 (content-pat (let ((icicle-list-use-nth-parts '(2)))
3247 (icicle-transform-multi-completion strg)))
3248 (nodes (mapcar #'car Info-read-node-completion-table))
3249 (nodes (icicle-remove-if-not
3250 `(lambda (nod) (icicle-string-match-p ',node-pat nod))
3251 nodes))
3252 (nodes (if (equal "" content-pat)
3253 nodes
3254 (icicle-remove-if-not
3255 `(lambda (nod) (icicle-Info-content-match ',content-pat nod))
3256 nodes))))
3257 (if completion-mode ; `all-completions', `test-completion'
3258 nodes
3259 (try-completion ; `try-completion'
3260 strg (mapcar #'list nodes) (and pred (lambda (ss) (funcall pred ss)))))))))
3261
3262 )
3263
3264 (defalias 'icicle-Info-goto-node (if (fboundp 'icicle-Info-goto-node-of-content) ; Emacs 22+
3265 'icicle-Info-goto-node-of-content
3266 'icicle-Info-goto-node-no-search))
3267
3268 (when (> emacs-major-version 21)
3269 (defun icicle-Info-virtual-book (nodeset)
3270 "Open Info on a virtual book of saved Info nodes.
3271 You need library `info+.el' to use this command.
3272 With a prefix arg, you are prompted to choose a persistent saved
3273 completion set from `icicle-saved-completion-sets'. The set you
3274 choose should be a set of saved Info node names.
3275 With no prefix arg, use `icicle-saved-completion-candidates', which
3276 should be a set of Info node names. If that is empty, then use
3277 `Info-saved-nodes'.
3278 Non-interactively, argument NODESET is a list of Info node names."
3279 (interactive
3280 (progn (unless (and (require 'info+ nil t) (fboundp 'Info-virtual-book))
3281 (icicle-user-error "You need library `info+.el' for this command"))
3282 (list (if (not current-prefix-arg)
3283 "Virtual Book"
3284 (save-selected-window
3285 (completing-read "Saved Info node set: " icicle-saved-completion-sets nil t nil
3286 'icicle-completion-set-history))))))
3287 (let ((nodes (and (consp nodeset) nodeset))) ; (), if interactive - NODESET is a string then.
3288 (when (interactive-p)
3289 (if (not current-prefix-arg)
3290 (setq nodes icicle-saved-completion-candidates)
3291 (let ((file-name (cdr (assoc nodeset icicle-saved-completion-sets))))
3292 (unless (icicle-file-readable-p file-name)
3293 (error "Cannot read cache file `%s'" file-name))
3294 (let ((list-buf (find-file-noselect file-name 'nowarn 'raw)))
3295 (unwind-protect
3296 (condition-case icicle-Info-virtual-book
3297 (when (listp (setq nodes (read list-buf)))
3298 (message "Set `%s' read from file `%s'" nodeset file-name))
3299 (error (error "Bad cache file. %s"
3300 (error-message-string icicle-Info-virtual-book))))
3301 (kill-buffer list-buf))
3302 (unless (consp nodes) (error "Bad data in cache file `%s'" file-name))))))
3303 (unless nodes (setq nodes Info-saved-nodes)) ; In `info+.el'.
3304 (unless (and nodes (stringp (car nodes))) (error "No saved Info nodes")) ; Minimal check.
3305 (unless (stringp nodeset) (setq nodeset "Virtual Book")) ; Non-interactive - NODESET is a list.
3306 (Info-virtual-book nodeset nodes))))
3307
3308 (icicle-define-command icicle-where-is ; Command name
3309 "Show keyboard/menu/mouse sequences that invoke specified command.
3310 This is a multi-command version of `where-is'.
3311
3312 With no prefix argument:
3313
3314 * Only commands actually bound to keys are completion candidates.
3315
3316 * Option `icicle-highlight-input-completion-failure' is temporarily
3317 bound to nil, so there is no highlighting of the mismatch part of
3318 your input. This is for performance reasons: it would be costly
3319 to try completing different prefixes of your input to look for the
3320 mismatch position.
3321
3322 NOTE: This is a significant difference from vanilla `where-is', which
3323 shows all commands as candidates, even those that are not bound.
3324
3325 With a prefix arg, all commands are candidates, as in vanilla Emacs.
3326
3327 With a plain (non-numeric) prefix arg, `C-u', insert the message in
3328 the current buffer, as in vanilla `where-is' with a prefix arg.
3329
3330 By default, Icicle mode remaps all key sequences that are normally
3331 bound to `where-is' to `icicle-where-is'. If you do not want this
3332 remapping, then customize option `icicle-top-level-key-bindings'." ; Doc string
3333 (lambda (x) (let ((symb (intern-soft x))) ; Action function
3334 (where-is symb (and pref-arg (consp pref-arg)))))
3335 (if pref-arg "Where is command: " "Where is bound command: ")
3336 obarray (and icompletep pred) t nil nil ; `completing-read' args
3337 (let ((fn (or (and (fboundp 'tap-symbol-nearest-point) ; Defined in `thingatpt+.el'.
3338 (tap-symbol-nearest-point))
3339 (function-called-at-point))))
3340 (and fn (symbol-name fn)))
3341 t
3342 ((pref-arg current-prefix-arg) ; Bindings
3343 (icicle-highlight-input-completion-failure (and pref-arg icicle-highlight-input-completion-failure))
3344 (pred (if pref-arg
3345 (lambda (cand)
3346 (unless (symbolp cand) (setq cand (intern cand)))
3347 (commandp cand))
3348 (lambda (cand)
3349 (unless (symbolp cand) (setq cand (intern cand)))
3350 (with-current-buffer icicle-orig-buff
3351 (and (commandp cand)
3352 (where-is-internal cand overriding-local-map
3353 'non-ascii))))))
3354 (icompletep (and (featurep 'icomplete) icomplete-mode))
3355 (icicle-must-pass-after-match-predicate (and (not icompletep) pred))
3356 (icicle-candidate-help-fn
3357 (lambda (cand)
3358 (with-current-buffer icicle-orig-buff
3359 (let* ((keys (where-is-internal (intern-soft cand) overriding-local-map))
3360 (keys1 (mapconcat #'icicle-key-description keys "', `")))
3361 (message (if (string= "" keys1)
3362 (format "`%s' is not on any key" cand)
3363 (format "`%s' is on `%s'" cand (icicle-propertize keys1 'face 'icicle-msg-emphasis))))
3364 (sit-for 3)))))
3365 (icicle-candidate-alt-action-fn
3366 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "command")))
3367 (icicle-all-candidates-list-alt-action-fn
3368 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "command")))))
3369
3370 (icicle-define-command icicle-vardoc ; Command name
3371 "Choose a variable description.
3372 Each candidate for completion is a variable name plus its
3373 documentation. They are separated by `icicle-list-join-string'
3374 \(\"^G^J\", by default). You can match an input regexp against the
3375 variable name or the documentation or both. Use `C-M-j' (equivalent
3376 here to `C-q C-g C-j') to input the default separator.
3377
3378 For example, use input
3379
3380 \"dired.*^G
3381 \[^^G]*list\"
3382
3383 with `S-TAB' to match all variables whose names contain \"dired\" and
3384 whose documentation contains \"list\". Here, `[^^G]' matches any
3385 character except ^G, which includes newline. If you use `.*' here,
3386 instead, then only the first lines of doc strings are searched.
3387
3388 With a prefix argument, use the same documentation that was gathered
3389 the last time `icicle-vardoc' was called. Use a prefix arg to save
3390 the time that would be needed to gather the documentation.
3391
3392 You can use `C-$' during completion to toggle limiting the domain of
3393 initial candidates to functions that are commands (interactive).
3394
3395 Remember that you can use `\\<minibuffer-local-completion-map>\
3396 \\[icicle-cycle-incremental-completion] to toggle incremental completion.
3397
3398 See also: `icicle-apropos-value'." ; Doc string
3399 icicle-doc-action ; Action function
3400 prompt ; `completing-read' args
3401 (let ((result (and pref-arg icicle-vardoc-last-initial-cand-set)))
3402 (unless result ; COLLECTION arg is an alist whose items are ((SYMB DOC)).
3403 (mapatoms (lambda (symb) ; Each completion candidate is a list of strings.
3404 (when (and (boundp symb)
3405 (or (wholenump (prefix-numeric-value pref-arg))
3406 (user-variable-p symb)))
3407 (let ((doc (documentation-property symb 'variable-documentation)))
3408 (when (icicle-non-whitespace-string-p doc)
3409 (push (list (list (symbol-name symb) doc)) result))))))
3410 (setq icicle-vardoc-last-initial-cand-set result))
3411 result)
3412 nil nil nil 'icicle-doc-history nil nil
3413 ((prompt "VAR `C-M-j' DOC: ") ; Bindings
3414 (icicle--last-toggle-transforming-msg icicle-toggle-transforming-message)
3415 (icicle-toggle-transforming-message "Filtering to user options is now %s")
3416 (icicle-transform-function nil) ; No transformation: all symbols.
3417 (icicle-last-transform-function (lambda (cands) ; `C-$': only options.
3418 (loop
3419 for cc in cands
3420 with symb
3421 do (setq symb (intern (icicle-transform-multi-completion cc)))
3422 if (user-variable-p symb)
3423 collect cc)))
3424 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
3425 (icicle-multi-completing-p t)
3426 (icicle-list-use-nth-parts '(1))
3427 (pref-arg current-prefix-arg))
3428 (progn ; First code
3429 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
3430 (icicle-highlight-lighter)
3431 (message "Gathering variable descriptions...")))
3432
3433 ;;; $$$$$$ (defun icicle-funvardoc-action (entry)
3434 ;;; "Action function for `icicle-vardoc', `icicle-fundoc', `icicle-plist'."
3435 ;;; (icicle-with-help-window "*Help*" (princ entry)))
3436
3437 (icicle-define-command icicle-fundoc ; Command name
3438 "Choose a function description.
3439 Each candidate for completion is a function name plus its
3440 documentation. They are separated by `icicle-list-join-string'
3441 \(\"^G^J\", by default). You can match an input regexp against the
3442 function name or the documentation or both. Use `C-M-j' (equivalent
3443 here to `C-q C-g C-j') to input the default separator.
3444
3445 For example, use input
3446
3447 \"dired.*^G
3448 \[^^G]*file\"
3449
3450 with `S-TAB' to match all functions whose names contain \"dired\" and
3451 whose documentation contains \"file\". Here, `[^^G]' matches any
3452 character except ^G, which includes newline. If you use `.*' here,
3453 instead, then only the first lines of doc strings are searched.
3454
3455 With a prefix argument, use the same documentation that was gathered
3456 the last time `icicle-fundoc' was called. Use a prefix arg to save
3457 the time that would be needed to gather the documentation.
3458
3459 You can use `C-$' during completion to toggle limiting the domain of
3460 initial candidates to functions that are commands (interactive).
3461
3462 Remember that you can use `\\<minibuffer-local-completion-map>\
3463 \\[icicle-cycle-incremental-completion] to toggle incremental completion.
3464
3465 See also: `icicle-apropos-value', using a negative prefix arg." ; Doc string
3466 icicle-doc-action ; Action function
3467 prompt ; `completing-read' args
3468 (let ((result (and pref-arg icicle-fundoc-last-initial-cand-set)))
3469 (unless result ; COLLECTION arg is an alist whose items are ((symb doc)).
3470 (mapatoms
3471 (lambda (symb) ; Each completion candidate is a list of strings.
3472 (when (fboundp symb)
3473 ;; Ignore symbols that produce errors. Example: In Emacs 20, `any', which is defalias'd
3474 ;; to `icicle-anything', raises this error: "Symbol's function definition is void: any".
3475 ;; This is caused by the `after' advice `ad-advised-docstring' that is defined by Emacs
3476 ;; itself for function `documentation'. It is not a problem for Emacs 22+.
3477 (let ((doc (condition-case nil (documentation symb) (error nil))))
3478 (when (and doc (icicle-non-whitespace-string-p (icicle-fn-doc-minus-sig doc)))
3479 (push (list (list (symbol-name symb) doc)) result))))))
3480 (setq icicle-fundoc-last-initial-cand-set result))
3481 result)
3482 nil nil nil 'icicle-doc-history nil nil
3483 ((prompt "FUNC `C-M-j' DOC: ") ; Bindings
3484 (icicle--last-toggle-transforming-msg icicle-toggle-transforming-message)
3485 (icicle-toggle-transforming-message "Filtering to commands is now %s")
3486 (icicle-transform-function nil) ; No transformation: all symbols.
3487 (icicle-last-transform-function (lambda (cands) ; `C-$': only commands.
3488 (loop for cc in cands
3489 with symb
3490 do (setq symb (intern
3491 (icicle-transform-multi-completion cc)))
3492 if (commandp symb)
3493 collect cc)))
3494 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
3495 (icicle-multi-completing-p t)
3496 (icicle-list-use-nth-parts '(1))
3497 (pref-arg current-prefix-arg))
3498 (progn ; First code
3499 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
3500 (icicle-highlight-lighter)
3501 (message "Gathering function descriptions...")))
3502
3503 (defun icicle-fn-doc-minus-sig (docstring)
3504 "Return DOCSTRING minus the function signature (usage info)."
3505 (let ((sig-p (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring)))
3506 (if sig-p (substring docstring 0 (match-beginning 0)) docstring)))
3507
3508 (icicle-define-command icicle-plist ; Command name
3509 "Choose a symbol and its property list.
3510 Each candidate for completion is a symbol name plus its property list
3511 \(as a string). They are separated by `icicle-list-join-string'
3512 \(^G^J, by default). You can match an input regexp against the symbol
3513 name or the property list or both. Use `C-M-j' (equivalent here to
3514 `C-q C-g C-j') to input the default separator.
3515
3516 With a positive prefix argument, use the same initial set of
3517 candidates that were gathered the last time `icicle-plist' was called.
3518 Use a positive prefix arg to save the time that would be needed to
3519 gather the plists.
3520
3521 With a negative prefix arg, do not pretty-print each property list, in
3522 buffers `*Help* and `*Completions*'. Generation of the complete set
3523 of candidates is about twice as fast when not pretty-printed, but the
3524 time to match your input and display candidates is the same, and the
3525 match-and-display time for empty input is much longer than the
3526 generation time.
3527
3528 The time to repeat (positive prefix arg) is the same, whether or not
3529 candidates were pretty-printed the first time.
3530
3531 Note: Plists are never pretty-printed for Emacs 20, because that seems
3532 to cause an Emacs crash.
3533
3534 You can use `C-$' during completion to toggle limiting the domain of
3535 initial candidates to functions that are commands (interactive).
3536
3537 Remember that you can use `\\<minibuffer-local-completion-map>\
3538 \\[icicle-cycle-incremental-completion] to toggle incremental completion.
3539
3540 See also: `icicle-apropos-value', using a positive prefix arg." ; Doc string
3541 icicle-doc-action ; Action function
3542 prompt ; `completing-read' args
3543 (let ((result (and pref-arg (wholenump (prefix-numeric-value pref-arg))
3544 icicle-plist-last-initial-cand-set)))
3545 (unless result ; COLLECTION arg: an alist with items ((symb plist-string))
3546 (mapatoms
3547 (lambda (symb) ; Each completion candidate is a list of strings.
3548 (condition-case nil ; Ignore symbols that produce errors.
3549 (let ((plist (symbol-plist symb)))
3550 (when plist
3551 (push (list (list (symbol-name symb)
3552 (if (or (< (prefix-numeric-value pref-arg) 0)
3553 (< emacs-major-version 21)) ; Emacs 20 crash if pprint.
3554 (format "%s" plist)
3555 (pp-to-string plist))))
3556 result)))
3557 (error nil))))
3558 (setq icicle-plist-last-initial-cand-set result))
3559 result)
3560 nil nil nil nil nil nil
3561 ((prompt "SYMB `C-M-j' PLIST: ") ; Bindings
3562 (icicle--last-toggle-transforming-msg icicle-toggle-transforming-message)
3563 (icicle-toggle-transforming-message "Filtering to faces is now %s")
3564 (icicle-transform-function nil) ; No transformation: all symbols.
3565 (icicle-last-transform-function
3566 (lambda (cands) ; `C-$': only faces.
3567 (loop for cc in cands
3568 with symb
3569 do (setq symb (intern (icicle-transform-multi-completion cc)))
3570 if (facep symb)
3571 collect cc)))
3572 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
3573 (icicle-multi-completing-p t)
3574 (icicle-list-use-nth-parts '(1))
3575 (pref-arg current-prefix-arg))
3576 (progn ; First code
3577 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
3578 (icicle-highlight-lighter)
3579 (message "Gathering property lists...")))
3580
3581 (icicle-define-command icicle-doc ; Command name
3582 "Choose documentation for a symbol.
3583 Each candidate for completion is the description of a function,
3584 variable, or face. Displays the documentation and returns the symbol.
3585
3586 Each candidate for completion is a symbol name plus its type
3587 \(FUNCTION, VARIABLE, or FACE) and its documentation. These candidate
3588 components are separated by `icicle-list-join-string' (\"^G^J\", by
3589 default). You can match an input regexp against the symbol name,
3590 type, or the documentation or any combination of the three. Use
3591 `C-M-j' (equivalent here to `C-q C-g C-j') to input the default
3592 separator.
3593
3594 With a prefix argument, use the same documentation that was gathered
3595 the last time `icicle-doc' was called. Use a prefix arg to save the
3596 time that would be needed to gather the documentation.
3597
3598 You can use `C-$' during completion to toggle filtering the domain of
3599 initial candidates between all functions, variables, and faces and
3600 only commands, user options and faces.
3601
3602 Remember that you can use \\<minibuffer-local-completion-map>\
3603 `\\[icicle-cycle-incremental-completion]' to toggle incremental completion.
3604
3605 See also: `icicle-apropos-value'." ; Doc string
3606 icicle-doc-action ; Action function: display the doc.
3607 prompt ; `completing-read' args
3608 (let ((result (and pref-arg icicle-doc-last-initial-cand-set))
3609 doc) ; Each completion candidate is a list of strings.
3610 (unless result ; COLLECTION arg is an alist with items (doc . symb).
3611 (mapatoms
3612 (lambda (symb)
3613 (progn
3614 (when (and (functionp symb) ; Function's doc.
3615 ;; Ignore symbols that produce errors. See comment for `icicle-fundoc'.
3616 (setq doc (condition-case nil (documentation symb) (error nil)))
3617 (setq doc (icicle-fn-doc-minus-sig doc)) ; Need separate `setq', for `and'.
3618 (icicle-non-whitespace-string-p doc)
3619 (setq doc (concat doc "\n\n")))
3620 (push (cons (list (concat (symbol-name symb) icicle-list-join-string "FUNCTION") doc)
3621 symb)
3622 result))
3623 (when (and (boundp symb) ; Variable's doc (and keymap var's bindings if remove nil)
3624 (setq doc (documentation-property symb 'variable-documentation))
3625 (icicle-non-whitespace-string-p doc))
3626 (when (and nil ; $$$ Remove nil to get keymaps, but it slows things down.
3627 (fboundp 'describe-keymap)
3628 (keymapp (symbol-value symb)))
3629 (setq doc (concat (symbol-name symb) ":\n" doc "\n\n" ; Keymap variable's doc.
3630 (substitute-command-keys
3631 (concat "\\{" (symbol-name symb) "}"))
3632 "\n\n")))
3633 (setq doc (concat doc "\n\n"))
3634 (push (cons (list (concat (symbol-name symb) icicle-list-join-string "VARIABLE") doc)
3635 symb)
3636 result))
3637 (when (and (facep symb)
3638 (setq doc (documentation-property symb 'face-documentation)))
3639 (push (cons (list (concat (symbol-name symb) icicle-list-join-string "FACE") doc)
3640 symb)
3641 result)))))
3642 (setq icicle-doc-last-initial-cand-set result))
3643 result)
3644 nil nil nil 'icicle-doc-history nil nil
3645 ((prompt "Find doc using regexp: ") ; Bindings
3646 ;; $$$$$$ (icicle-transform-function 'icicle-remove-duplicates) ; Duplicates are due to `fset's.
3647 (icicle--last-toggle-transforming-msg icicle-toggle-transforming-message)
3648 (icicle-toggle-transforming-message "Filtering to OPTIONS, COMMANDS, & FACES is now %s")
3649 (icicle-transform-function nil) ; No transformation: all symbols.
3650 (icicle-last-transform-function (lambda (cands) ; `C-$': only user options, commands, or faces.
3651 (loop for cc in cands
3652 with symb
3653 do (setq symb (intern (icicle-transform-multi-completion cc)))
3654 if (or (user-variable-p symb) (commandp symb) (facep symb))
3655 collect cc)))
3656 (icicle-candidate-properties-alist '((1 (face icicle-candidate-part))))
3657 (icicle-multi-completing-p t)
3658 (icicle-list-use-nth-parts '(1))
3659 (icicle-candidate-help-fn 'icicle-doc-action)
3660 (pref-arg current-prefix-arg))
3661 (progn ; First code
3662 (put-text-property 0 1 'icicle-fancy-candidates t prompt)
3663 (icicle-highlight-lighter)
3664 (message "Gathering documentation...")))
3665
3666 (defun icicle-doc-action (entry)
3667 "Completion action function for `icicle-doc': Display the doc."
3668 (let ((symb (intern (icicle-transform-multi-completion entry))))
3669 (cond ((fboundp symb) (describe-function symb))
3670 ;; $$$ This works fine, but it slows things down:
3671 ;; ((and (fboundp 'describe-keymap) (boundp symb) (keymapp (symbol-value symb)))
3672 ;; (describe-keymap symb))
3673 ((and symb (boundp symb)) (describe-variable symb))
3674 ((facep symb) (describe-face symb)))
3675 symb))
3676
3677 (defun icicle-non-whitespace-string-p (string)
3678 "Return non-nil if STRING is a string and contains a non-whitespace char.
3679 The `standard-syntax-table' definition of whitespace is used."
3680 (interactive "s")
3681 (let ((orig-syntable (syntax-table)))
3682 (unwind-protect
3683 (progn
3684 (set-syntax-table (standard-syntax-table))
3685 (and (stringp string) (> (length string) 0) (string-match "\\S-" string)))
3686 (set-syntax-table orig-syntable))))
3687
3688 (defalias 'icicle-map 'icicle-apply)
3689 (defun icicle-apply (alist fn &optional nomsg predicate initial-input hist def inherit-input-method)
3690 "Selectively apply a function to elements in an alist.
3691 Argument ALIST is an alist such as can be used as the COLLECTION
3692 argument for Icicles `completing-read'. Its elements can represent
3693 multi-completions, for example. Interactively, COLLECTION is a
3694 variable (a symbol) whose value is an alist.
3695
3696 Argument FN is a function.
3697
3698 Optional argument NOMSG non-nil means do not display an informative
3699 message each time FN is applied. If nil, then a message shows the key
3700 of the alist element that FN is applied to and the result of the
3701 application.
3702
3703 The remaining arguments are optional. They are the arguments
3704 PREDICATE, INITIAL-INPUT, HIST, DEF, and INHERIT-INPUT-METHOD for
3705 `completing-read' (that is, all of the `completing-read' args other
3706 than PROMPT, COLLECTION, and REQUIRE-MATCH). During `icicle-apply'
3707 completion, a match is required (REQUIRE-MATCH is t).
3708
3709 Interactively, you are prompted for both arguments. Completion is
3710 available for each. The completion list for ALIST candidates is the
3711 set of variables whose value is a cons. With no prefix argument, the
3712 names of these variables must end with \"alist\". With a prefix
3713 argument, the first car of each variable value must itself be a cons.
3714
3715 After choosing the ALIST and FN, you are prompted to choose one or
3716 more keys of the alist elements, and FN is applied to each element
3717 that has a key that you