Update icicles
[emacs.git] / .emacs.d / elisp / icicle / icicles-mac.el
1 ;;; icicles-mac.el --- Macros for Icicles
2 ;;
3 ;; Filename: icicles-mac.el
4 ;; Description: Macros for Icicles
5 ;; Author: Drew Adams
6 ;; Maintainer: Drew Adams (concat "drew.adams" "@" "oracle" ".com")
7 ;; Copyright (C) 1996-2015, Drew Adams, all rights reserved.
8 ;; Created: Mon Feb 27 09:24:28 2006
9 ;; Last-Updated: Wed Jan 21 08:52:30 2015 (-0800)
10 ;; By: dradams
11 ;; Update #: 1268
12 ;; URL: http://www.emacswiki.org/icicles-mac.el
13 ;; Doc URL: http://www.emacswiki.org/Icicles
14 ;; Keywords: internal, extensions, help, abbrev, local, minibuffer,
15 ;; keys, apropos, completion, matching, regexp, command
16 ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x, 25.x
17 ;;
18 ;; Features that might be required by this library:
19 ;;
20 ;; None
21 ;;
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
23 ;;
24 ;;; Commentary:
25 ;;
26 ;; This is a helper library for library `icicles.el'. It defines
27 ;; macros. For Icicles documentation, see `icicles-doc1.el' and
28 ;; `icicles-doc2.el'.
29 ;;
30 ;; Macros defined here:
31 ;;
32 ;; `icicle-buffer-bindings', `icicle-condition-case-no-debug',
33 ;; `icicle-define-add-to-alist-command',
34 ;; `icicle-define-bookmark-command',
35 ;; `icicle-define-bookmark-command-1',
36 ;; `icicle-define-bookmark-other-window-command',
37 ;; `icicle-define-command', `icicle-define-file-command',
38 ;; `icicle-define-search-bookmark-command',
39 ;; `icicle-define-sort-command', `icicle-file-bindings',
40 ;; `icicle-menu-bar-make-toggle', `icicle-user-error',
41 ;; `icicle-with-help-window', `icicle-with-icy-mode-OFF',
42 ;; `icicle-with-icy-mode-ON', `icicle-with-selected-window'.
43 ;;
44 ;; Non-interactive functions defined here:
45 ;;
46 ;; `icicle-assoc-delete-all', `icicle-remove-if'.
47 ;;
48 ;; You might also be interested in my library `imenu+.el', which
49 ;; teaches the macros defined here to Imenu, so the functions defined
50 ;; with those macros show up in Imenu menus.
51 ;;
52 ;; For descriptions of changes to this file, see `icicles-chg.el'.
53 ;;
54 ;; ******************
55 ;; NOTE: Whenever you update Icicles (i.e., download new versions of
56 ;; Icicles source files), I recommend that you do the following:
57 ;;
58 ;; 1. Delete all existing byte-compiled Icicles files
59 ;; (icicles*.elc).
60 ;; 2. Load Icicles (`load-library' or `require').
61 ;; 3. Byte-compile the source files.
62 ;;
63 ;; In particular, always load `icicles-mac.el' (not
64 ;; `icicles-mac.elc') before you byte-compile new versions of the
65 ;; files, in case there have been any changes to Lisp macros (in
66 ;; `icicles-mac.el').
67 ;; ******************
68
69 ;;(@> "Index")
70 ;;
71 ;; If you have library `linkd.el' and Emacs 22 or later, load
72 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
73 ;; navigate around the sections of this doc. Linkd mode will
74 ;; highlight this Index, as well as the cross-references and section
75 ;; headings throughout this file. You can get `linkd.el' here:
76 ;; http://dto.freeshell.org/notebook/Linkd.html.
77 ;;
78 ;; (@> "Macros")
79
80 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
81 ;;
82 ;; This program is free software; you can redistribute it and/or modify
83 ;; it under the terms of the GNU General Public License as published by
84 ;; the Free Software Foundation; either version 3, or (at your option)
85 ;; any later version.
86 ;;
87 ;; This program is distributed in the hope that it will be useful,
88 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
89 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
90 ;; GNU General Public License for more details.
91 ;;
92 ;; You should have received a copy of the GNU General Public License
93 ;; along with this program; see the file COPYING. If not, write to the
94 ;; Free Software Foundation, Inc., 51 Franklin Street,
95 ;; Fifth Floor, Boston, MA 02110-1301, USA.
96 ;;
97 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
98 ;;
99 ;;; Code:
100
101 ;; Byte-compiling this file, you will likely get some error or warning
102 ;; messages. All of the following are benign. They are due to
103 ;; differences between different versions of Emacs.
104 ;;
105 ;; Compiling in Emacs 20:
106 ;;
107 ;; the function x-focus-frame is not known to be defined.
108
109 (eval-when-compile (require 'cl)) ;; incf, plus for Emacs < 21: dolist, push
110
111 ;; Quiet the byte compiler for Emacs versions before 22. For some reason, a value is required.
112 (unless (boundp 'minibuffer-completing-symbol)
113 (defvar minibuffer-completing-symbol nil)
114 (defvar minibuffer-message-timeout 2)
115 (defvar minibuffer-prompt-properties nil))
116
117 ;; Quiet the byte-compiler.
118 (defvar icicle-buffer-completing-p)
119 (defvar icicle-file-completing-p)
120 (defvar icicle-inhibit-try-switch-buffer)
121 (defvar read-file-name-completion-ignore-case)
122
123 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
124
125 ;;(@* "Macros")
126
127 ;;; Macros -----------------------------------------------------------
128
129 ;; $$$$$$
130 ;; Same as vanilla `condition-case-no-debug', which is available starting with Emacs 23.
131 ;; (defmacro icicle-condition-case-no-debug (var bodyform &rest handlers)
132 ;; "Like `condition-case', but does not catch anything when debugging.
133 ;; Specifically, non-nil `debug-on-error' means catch no signals.
134 ;; This is the same as `condition-case-no-debug': added to use in older
135 ;; Emacs versions too."
136 ;; (let ((bodysym (make-symbol "body")))
137 ;; `(let ((,bodysym (lambda () ,bodyform)))
138 ;; (if debug-on-error
139 ;; (funcall ,bodysym)
140 ;; (condition-case ,var
141 ;; (funcall ,bodysym)
142 ;; ,@handlers)))))
143
144 ;; Same definition as in `icicles-fn.el'.
145 (defun icicle-remove-if (pred xs)
146 "A copy of list XS with no elements that satisfy predicate PRED."
147 (let ((result ()))
148 (dolist (x xs) (unless (funcall pred x) (push x result)))
149 (nreverse result)))
150
151 ;; Same definition as in `icicles-fn.el'.
152 (defun icicle-assoc-delete-all (key alist)
153 "Delete from ALIST all elements whose car is `equal' to KEY.
154 Return the modified alist.
155 Elements of ALIST that are not conses are ignored."
156 (while (and (consp (car alist)) (equal (car (car alist)) key))
157 (setq alist (cdr alist)))
158 (let ((tail alist)
159 tail-cdr)
160 (while (setq tail-cdr (cdr tail))
161 (if (and (consp (car tail-cdr)) (equal (car (car tail-cdr)) key))
162 (setcdr tail (cdr tail-cdr))
163 (setq tail tail-cdr))))
164 alist)
165
166 (defmacro icicle-condition-case-no-debug (var bodyform &rest handlers)
167 "Like `condition-case', but do not catch per `debug-on-(error|quit)'.
168 If both `debug-on-error' and `debug-on-quit' are non-nil, then handle
169 only other signals - enter the debugger for errors and `C-g'.
170
171 If `debug-on-error' is non-nil and `debug-on-quit' is nil, then handle
172 all signals except errors that would be caught by an `error' handler.
173 Enter the debugger on such errors.
174
175 If `debug-on-quit' is non-nil and `debug-on-error' is nil, then handle
176 all signals except quitting. Enter the debugger on quit (`C-g').
177
178 NOTE:
179 1. This does not treat `error' and `quit' handlers specially when
180 they are in a list that is the car of a handler. In such a case
181 the handler remains in effect in spite of the values of
182 `debug-on-(error|quit)'.
183
184 2. Only errors that would be caught by an `error' handler (if one were
185 present) enter the debugger when `debug-on-error' is non-nil. When
186 a specific error handler (e.g. `arith-error') is present, it still
187 handles such an error - the debugger is not entered just because
188 `debug-on-error' is non-nil."
189 (let ((bodysym (make-symbol "body")))
190 `(let ((,bodysym (lambda () ,bodyform)))
191 (cond ((and debug-on-error debug-on-quit)
192 (condition-case ,var
193 (funcall ,bodysym)
194 ,@(icicle-remove-if
195 (lambda (hh) (memq (car hh) '(error quit)))
196 handlers)))
197 (debug-on-error
198 (condition-case ,var
199 (funcall ,bodysym)
200 ,@(icicle-remove-if
201 (lambda (hh) (eq (car hh) 'error))
202 handlers)))
203 (debug-on-quit
204 (condition-case ,var
205 (funcall ,bodysym)
206 ,@(icicle-remove-if
207 (lambda (hh) (eq (car hh) 'quit))
208 handlers)))
209 (t
210 (condition-case ,var
211 (funcall ,bodysym)
212 ,@handlers))))))
213
214 (if (fboundp 'with-selected-window) ; Emacs 22+
215 (defalias 'icicle-with-selected-window (symbol-function 'with-selected-window))
216 (defmacro icicle-with-selected-window (window &rest body)
217 "Execute the forms in BODY with WINDOW as the selected window.
218 The value returned is the value of the last form in BODY.
219
220 This macro saves and restores the selected window, as well as the
221 selected window of each frame. It does not change the order of
222 recently selected windows. If the previously selected window of
223 some frame is no longer live at the end of BODY, that frame's
224 selected window is left alone. If the selected window is no
225 longer live, then whatever window is selected at the end of BODY
226 remains selected.
227
228 This macro uses `save-current-buffer' to save and restore the
229 current buffer, since otherwise its normal operation could
230 potentially make a different buffer current. It does not alter
231 the buffer list ordering."
232 ;; Most of this code is a copy of save-selected-window.
233 `(let ((save-selected-window-window (selected-window))
234 ;; It is necessary to save all of these, because calling
235 ;; select-window changes frame-selected-window for whatever
236 ;; frame that window is in.
237 (save-selected-window-alist (mapcar (lambda (frame)
238 (list frame (frame-selected-window frame)))
239 (frame-list))))
240 (save-current-buffer
241 (unwind-protect
242 (progn (if (> emacs-major-version 21)
243 (select-window ,window 'norecord) ; Emacs 22+
244 (select-window ,window))
245 ,@body)
246 (dolist (elt save-selected-window-alist)
247 (and (frame-live-p (car elt))
248 (window-live-p (cadr elt))
249 (if (> emacs-major-version 22)
250 (set-frame-selected-window (car elt) (cadr elt) 'norecord) ; Emacs 23+
251 (set-frame-selected-window (car elt) (cadr elt)))))
252 (when (window-live-p save-selected-window-window)
253 (if (> emacs-major-version 21)
254 (select-window save-selected-window-window 'norecord) ; Emacs 22+
255 (select-window save-selected-window-window))))))))
256
257 (defmacro icicle-user-error (&rest args)
258 "`user-error' if defined, otherwise `error'."
259 `(if (fboundp 'user-error) (user-error ,@args) (error ,@args)))
260
261 (defmacro icicle-define-add-to-alist-command (command doc-string construct-item-fn alist-var
262 &optional dont-save)
263 "Define COMMAND that adds an item to an alist user option.
264 Any items with the same key are first removed from the alist.
265 DOC-STRING is the doc string of COMMAND.
266 CONSTRUCT-ITEM-FN is a function that constructs the new item.
267 It reads user input.
268 ALIST-VAR is the alist user option.
269 Optional arg DONT-SAVE non-nil means do not call
270 `customize-save-variable' to save the updated variable."
271 `(defun ,command ()
272 ,(concat doc-string "\n\nNote: Any items with the same key are first removed from the alist.")
273 (interactive)
274 (let ((new-item (funcall ,construct-item-fn)))
275 (setq ,alist-var (icicle-assoc-delete-all (car new-item) ,alist-var))
276 (push new-item ,alist-var)
277 ,(unless dont-save `(customize-save-variable ',alist-var ,alist-var))
278 (message "Added to `%s': `%S'" ',alist-var new-item))))
279
280 (defmacro icicle-buffer-bindings (&optional pre-bindings post-bindings)
281 "Bindings to use in multi-command definitions for buffer names.
282 PRE-BINDINGS is a list of additional bindings, which are created
283 before the others. POST-BINDINGS is similar, but the bindings are
284 created after the others."
285 ;; Use `append' rather than backquote syntax (with ,@post-bindings in particular) because of a bug
286 ;; in Emacs 20. This ensures that you can byte-compile in, say, Emacs 20 and still use the result
287 ;; in later Emacs releases.
288 `,(append
289 pre-bindings
290 `((icicle-buffer-name-input-p t) ; But must also be non-nil for non multi-commands.
291 (icicle-buffer-complete-fn (and (fboundp 'internal-complete-buffer)
292 'internal-complete-buffer))
293 (completion-ignore-case (or (and (boundp 'read-buffer-completion-ignore-case)
294 read-buffer-completion-ignore-case)
295 completion-ignore-case))
296 (icicle-show-Completions-initially-flag (or icicle-show-Completions-initially-flag
297 icicle-buffers-ido-like-flag))
298 (icicle-top-level-when-sole-completion-flag (or icicle-top-level-when-sole-completion-flag
299 icicle-buffers-ido-like-flag))
300 (icicle-default-value (if (and icicle-buffers-ido-like-flag
301 icicle-default-value)
302 icicle-buffers-ido-like-flag
303 icicle-default-value))
304 (icicle-must-match-regexp icicle-buffer-match-regexp)
305 (icicle-must-not-match-regexp icicle-buffer-no-match-regexp)
306 (icicle-must-pass-after-match-predicate icicle-buffer-predicate)
307 (icicle-require-match-flag icicle-buffer-require-match-flag)
308 (icicle-buffer-completing-p t)
309 (icicle-extra-candidates icicle-buffer-extras)
310 (icicle-delete-candidate-object 'icicle-kill-a-buffer) ; `S-delete' kills current buf
311 (icicle-transform-function 'icicle-remove-dups-if-extras)
312 (icicle--temp-orders
313 (append (list
314 '("by last display time") ; Renamed from "turned OFF'.
315 '("*...* last" . icicle-buffer-sort-*...*-last)
316 '("by buffer size" . icicle-buffer-smaller-p)
317 '("by major mode name" . icicle-major-mode-name-less-p)
318 (and (fboundp 'icicle-mode-line-name-less-p)
319 '("by mode-line mode name" . icicle-mode-line-name-less-p))
320 '("by file/process name" . icicle-buffer-file/process-name-less-p))
321 (delete '("turned OFF") (copy-sequence icicle-sort-orders-alist))))
322 ;; Put `icicle-buffer-sort' first. If already in the list, move it, else add it, to beginning.
323 (icicle-sort-orders-alist
324 (progn (when (and icicle-buffer-sort-first-time-p icicle-buffer-sort)
325 (setq icicle-sort-comparer icicle-buffer-sort
326 icicle-buffer-sort-first-time-p nil))
327 (if icicle-buffer-sort
328 (let ((already-there (rassq icicle-buffer-sort icicle--temp-orders)))
329 (if already-there
330 (cons already-there (setq icicle--temp-orders (delete already-there
331 icicle--temp-orders)))
332 (cons `("by `icicle-buffer-sort'" . ,icicle-buffer-sort) icicle--temp-orders)))
333 icicle--temp-orders)))
334 (icicle-candidate-alt-action-fn
335 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "buffer")))
336 (icicle-all-candidates-list-alt-action-fn
337 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "buffer")))
338 (icicle-bufflist
339 (if (eq 'use-default icicle-buffer-prefix-arg-filtering)
340 (if (not current-prefix-arg)
341 (buffer-list)
342 (cond ((and (consp current-prefix-arg)
343 (> (prefix-numeric-value current-prefix-arg) 16)) ; `C-u C-u C-u'
344 (icicle-remove-if (lambda (bf) (get-buffer-window bf 0)) (buffer-list)))
345 ((and (consp current-prefix-arg)
346 (> (prefix-numeric-value current-prefix-arg) 4)) ; `C-u C-u'
347 (icicle-remove-if-not (lambda (bf) (get-buffer-window bf 0)) (buffer-list)))
348 ((and (consp current-prefix-arg) (fboundp 'derived-mode-p)) ; `C-u'
349 (icicle-remove-if-not (lambda (bf)
350 (derived-mode-p (with-current-buffer bf major-mode)))
351 (buffer-list)))
352 ((zerop (prefix-numeric-value current-prefix-arg)) ; `C-0'
353 (let ((this-mode major-mode))
354 (icicle-remove-if-not `(lambda (bf)
355 (with-current-buffer bf (eq major-mode ',this-mode)))
356 (buffer-list))))
357 ((< (prefix-numeric-value current-prefix-arg) 0) ; `C--'
358 (cdr (assq 'buffer-list (frame-parameters))))
359 (t ; `C-1'
360 (icicle-remove-if-not (lambda (bf)
361 (or (buffer-file-name bf)
362 (with-current-buffer bf (eq major-mode 'dired-mode))))
363 (buffer-list)))))
364 (catch 'icicle-buffer-bindings
365 (dolist (entry icicle-buffer-prefix-arg-filtering)
366 (when (funcall (car entry) current-prefix-arg)
367 (throw 'icicle-buffer-bindings
368 (if (cdr entry) (icicle-remove-if (cdr entry) (buffer-list)) (buffer-list)))))
369 (buffer-list))))
370 (icicle-bufflist
371 (icicle-remove-if
372 (lambda (bf) (icicle-string-match-p "^ [*]Minibuf-[0-9]" (buffer-name bf)))
373 icicle-bufflist)))
374 post-bindings))
375
376 (defmacro icicle-file-bindings (&optional pre-bindings post-bindings)
377 "Bindings to use in multi-command definitions for file names.
378 PRE-BINDINGS is a list of additional bindings, which are created
379 before the others. POST-BINDINGS is similar, but the bindings are
380 created after the others."
381 ;; We use `append' rather than backquote syntax (with ,@post-bindings in particular) because of a bug
382 ;; in Emacs 20. This ensures that you can byte-compile in, say, Emacs 20 and still use the result
383 ;; in later Emacs releases.
384 `,(append
385 pre-bindings
386 `((completion-ignore-case
387 (or (and (boundp 'read-file-name-completion-ignore-case) read-file-name-completion-ignore-case)
388 completion-ignore-case))
389 (icicle-show-Completions-initially-flag (or icicle-show-Completions-initially-flag
390 icicle-files-ido-like-flag))
391 (icicle-top-level-when-sole-completion-flag (or icicle-top-level-when-sole-completion-flag
392 icicle-files-ido-like-flag))
393 (icicle-default-value (if (and icicle-files-ido-like-flag
394 icicle-default-value)
395 icicle-files-ido-like-flag
396 ;; Get default via `M-n', but do not insert it.
397 (and (memq icicle-default-value '(t nil))
398 icicle-default-value)))
399 (icicle-must-match-regexp icicle-file-match-regexp)
400 (icicle-must-not-match-regexp icicle-file-no-match-regexp)
401 (icicle-must-pass-after-match-predicate icicle-file-predicate)
402 (icicle-require-match-flag icicle-file-require-match-flag)
403 (icicle-file-completing-p t)
404 (icicle-extra-candidates icicle-file-extras)
405 (icicle-transform-function 'icicle-remove-dups-if-extras)
406 ;; Put `icicle-file-sort' first. If already in the list, move it, else add it, to beginning.
407 (icicle--temp-orders (copy-sequence icicle-sort-orders-alist))
408 (icicle-sort-orders-alist
409 (progn (when (and icicle-file-sort-first-time-p icicle-file-sort)
410 (setq icicle-sort-comparer icicle-file-sort
411 icicle-file-sort-first-time-p nil))
412 (if icicle-file-sort
413 (let ((already-there (rassq icicle-file-sort icicle--temp-orders)))
414 (if already-there
415 (cons already-there (setq icicle--temp-orders (delete already-there
416 icicle--temp-orders)))
417 (cons `("by `icicle-file-sort'" ,@icicle-file-sort) icicle--temp-orders)))
418 icicle--temp-orders)))
419 (icicle-candidate-help-fn (lambda (cand)
420 (icicle-describe-file cand current-prefix-arg t)))
421 (icicle-candidate-alt-action-fn
422 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "file")))
423 (icicle-all-candidates-list-alt-action-fn
424 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "file")))
425 (icicle-delete-candidate-object 'icicle-delete-file-or-directory))
426 post-bindings))
427
428 (defmacro icicle-define-command
429 (command doc-string function prompt collection &optional
430 predicate require-match initial-input hist def inherit-input-method
431 bindings first-sexp undo-sexp last-sexp not-interactive-p)
432 ;; Hard-code these in doc string, because \\[...] prefers ASCII
433 ;; `C-return' instead of `\\[icicle-candidate-action]'
434 ;; `C-down' instead of `\\[icicle-next-candidate-per-mode-action]'
435 ;; `C-up', `C-wheel-up' instead of `\\[icicle-previous-candidate-per-mode-action]'
436 ;; `C-next' instead of `\\[icicle-next-apropos-candidate-action]'
437 ;; `C-prior' instead of `\\[icicle-previous-apropos-candidate-action]'
438 ;; `C-end' instead of `\\[icicle-next-prefix-candidate-action]'
439 ;; `C-home' instead of `\\[icicle-previous-prefix-candidate-action]'
440 "Define COMMAND with DOC-STRING based on FUNCTION.
441 COMMAND is a symbol. DOC-STRING is a string.
442 FUNCTION is a function that takes one argument, read as input.
443 (If the argument to FUNCTION is a file name or directory name, then
444 use macro `icicle-define-file-command', instead.)
445
446 BINDINGS is a list of `let*' bindings added around the command code.
447 The following bindings are pre-included - you can refer to them in
448 the command body (including in FIRST-SEXP, LAST-SEXP, UNDO-SEXP).
449
450 `icicle-orig-buff' is bound to (current-buffer)
451 `icicle-orig-window' is bound to (selected-window)
452 BINDINGS is macroexpanded, so it can also be a macro call that expands
453 to a list of bindings. For example, you can use
454 `icicle-buffer-bindings' here.
455
456 In case of user quit (`C-g') or error, an attempt is made to restore
457 the original buffer.
458
459 FIRST-SEXP is a sexp evaluated before the main body of the command.
460 UNDO-SEXP is a sexp evaluated in case of error or if the user quits.
461 LAST-SEXP is a sexp evaluated after the main body of the command.
462 It is always evaluated, in particular, even in case of error or quit.
463 NOT-INTERACTIVE-P non-nil means to define COMMAND as a non-interactive
464 function that reads multi-command input.
465
466 Other arguments are as for `completing-read'.
467
468 In order, the created command does this:
469
470 - Uses DOC-STRING, with information about Icicles bindings appended.
471 - Binds BINDINGS for the rest of the command.
472 - Evaluates FIRST-SEXP.
473 - Reads input with `completing-read', using PROMPT, COLLECTION,
474 PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
475 INHERIT-INPUT-METHOD.
476 - Calls FUNCTION on the input that was read.
477 - Evaluates UNDO-SEXP in case of error or if the user quits.
478 - Evaluates LAST-SEXP.
479
480 The created command also binds `icicle-candidate-action-fn' to a
481 function that calls FUNCTION on the current completion candidate.
482 Note that the BINDINGS are of course not in effect within
483 `icicle-candidate-action-fn'."
484 (let ((choice (make-symbol "cmd-choice"))
485 (hide-common (make-symbol "hide-common-match"))
486 (no-incr-comp (make-symbol "no-incr-comp"))
487 (no-icomplete (make-symbol "no-icomplete")))
488 `(defun ,command ()
489 ,(concat doc-string "\n\nRead input, then "
490 (and (symbolp function) (concat "call `" (symbol-name function) "'\nto "))
491 "act on it.
492
493 Input-candidate completion and cycling are available. While cycling,
494 these keys with prefix `C-' are active:
495
496 \\<minibuffer-local-completion-map>\
497 `C-mouse-2', `C-return' - Act on current completion candidate only
498 `C-down', `C-wheel-down' - Move to next completion candidate and act
499 `C-up', `C-wheel-up' - Move to previous completion candidate and act
500 `C-next' - Move to next apropos-completion candidate and act
501 `C-prior' - Move to previous apropos-completion candidate and act
502 `C-end' - Move to next prefix-completion candidate and act
503 `C-home' - Move to previous prefix-completion candidate and act
504 `\\[icicle-all-candidates-action]' - Act on *all* candidates, successively (careful!)
505
506 When candidate action and cycling are combined (e.g. `C-next'), user
507 option `icicle-act-before-cycle-flag' determines which occurs first.
508
509 With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2',
510 `C-M-RET', `C-M-down', and so on) provide help about candidates.
511
512 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or
513 `C-g' to quit.
514
515 This is an Icicles command - see command `icicle-mode'.")
516 ,(and (not not-interactive-p) '(interactive))
517 (let* ((icicle-orig-buff (current-buffer))
518 (icicle-orig-window (selected-window))
519 ,@(macroexpand bindings) ; User-provided bindings.
520 (icicle-candidate-action-fn
521 (lambda (candidate)
522 (let ((minibuffer-completion-table minibuffer-completion-table)
523 (minibuffer-completion-predicate minibuffer-completion-predicate)
524 (minibuffer-completion-confirm minibuffer-completion-confirm)
525 (minibuffer-completing-file-name minibuffer-completing-file-name)
526 (minibuffer-completing-symbol (and (boundp 'minibuffer-completing-symbol)
527 minibuffer-completing-symbol))
528 (minibuffer-exit-hook minibuffer-exit-hook)
529 (minibuffer-help-form minibuffer-help-form)
530 (minibuffer-history-variable minibuffer-history-variable)
531 (minibuffer-history-case-insensitive-variables
532 minibuffer-history-case-insensitive-variables)
533 (minibuffer-history-sexp-flag minibuffer-history-sexp-flag)
534 (minibuffer-message-timeout (and (boundp 'minibuffer-message-timeout)
535 minibuffer-message-timeout))
536 (minibuffer-prompt-properties (and (boundp 'minibuffer-prompt-properties)
537 minibuffer-prompt-properties))
538 (minibuffer-setup-hook minibuffer-setup-hook)
539 (minibuffer-text-before-history minibuffer-text-before-history))
540 (icicle-condition-case-no-debug in-action-fn
541 ;; Treat 3 cases, because previous use of `icicle-candidate-action-fn'
542 ;; might have killed the buffer or deleted the window.
543 (cond ((and (buffer-live-p icicle-orig-buff) (window-live-p icicle-orig-window))
544 (with-current-buffer icicle-orig-buff
545 (save-selected-window (select-window icicle-orig-window)
546 (funcall #',function candidate))))
547 ((window-live-p icicle-orig-window)
548 (save-selected-window (select-window icicle-orig-window)
549 (funcall #',function candidate)))
550 (t
551 (funcall #',function candidate)))
552 (error (unless (string= "Cannot switch buffers in minibuffer window"
553 (error-message-string in-action-fn))
554 (error "%s" (error-message-string in-action-fn)))
555 (when (window-live-p icicle-orig-window)
556 (select-window icicle-orig-window)
557 (select-frame-set-input-focus (selected-frame)))
558 (funcall #',function candidate)))
559 (select-window (minibuffer-window))
560 (select-frame-set-input-focus (selected-frame))
561 nil)))) ; Return nil for success.
562
563 (icicle-condition-case-no-debug catch-top-level
564 (catch 'icicle-top-level
565 (let (,hide-common ,no-incr-comp ,no-icomplete)
566 (when (and (get this-command 'icicle-hide-common-match)
567 (not icicle-hide-common-match-in-Completions-flag))
568 (setq icicle-hide-common-match-in-Completions-flag t
569 ,hide-common t))
570 (when (and (get this-command 'icicle-turn-off-incremental-completion)
571 icicle-incremental-completion)
572 (setq icicle-incremental-completion nil
573 ,no-incr-comp t))
574 (when (and (get this-command 'icicle-turn-off-icomplete-mode)
575 (featurep 'icomplete) icomplete-mode)
576 (icomplete-mode -1)
577 (setq ,no-icomplete t))
578 (when (or ,hide-common ,no-incr-comp ,no-icomplete)
579 (message "Turned OFF: %s%s%s%s%s"
580 (if ,hide-common
581 (concat (icicle-propertize "showing common match"
582 'face 'icicle-msg-emphasis)
583 " (`C-x .')")
584 "")
585 (if (and ,hide-common (or ,no-incr-comp ,no-icomplete)) ", " "")
586 (if ,no-incr-comp
587 (concat (icicle-propertize "incremental completion"
588 'face 'icicle-msg-emphasis)
589 " (`C-#')")
590 "")
591 (if (and ,no-incr-comp ,no-icomplete) ", " "")
592 (if ,no-icomplete
593 (concat (icicle-propertize "Icomplete mode"
594 'face 'icicle-msg-emphasis)
595 " (`C-M-#')")
596 ""))
597 (sit-for 3))
598 ,first-sexp
599 (icicle-condition-case-no-debug act-on-choice
600 (let ((,choice
601 (if icicle-buffer-name-input-p
602 (icicle-read-buffer ,prompt ,def ,require-match)
603 (completing-read ,prompt ,collection ,predicate ,require-match
604 ,initial-input ,hist ,def ,inherit-input-method))))
605 ;; Reset after reading input, so commands can tell if input has been read.
606 (setq icicle-candidate-action-fn nil)
607 (funcall #',function ,choice))
608 (quit (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp)
609 (error (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp
610 (error "%s" (error-message-string act-on-choice)))))
611 ,last-sexp)
612 (quit (icicle-try-switch-buffer icicle-orig-buff) ,last-sexp)
613 (error (icicle-try-switch-buffer icicle-orig-buff) ,last-sexp
614 (error "%s" (error-message-string catch-top-level))))))))
615
616 (defmacro icicle-define-file-command
617 (command doc-string function prompt &optional
618 dir default-filename require-match initial-input predicate
619 bindings first-sexp undo-sexp last-sexp not-interactive-p)
620 ;; Hard-code these in doc string, because \\[...] prefers ASCII
621 ;; `C-return' instead of `\\[icicle-candidate-action]'
622 ;; `C-down' instead of `\\[icicle-next-candidate-per-mode-action]'
623 ;; `C-up', `C-wheel-up' instead of `\\[icicle-previous-candidate-per-mode-action]'
624 ;; `C-next' instead of `\\[icicle-next-apropos-candidate-action]'
625 ;; `C-prior' instead of `\\[icicle-previous-apropos-candidate-action]'
626 ;; `C-end' instead of `\\[icicle-next-prefix-candidate-action]'
627 ;; `C-home' instead of `\\[icicle-previous-prefix-candidate-action]'
628 "Define COMMAND with DOC-STRING based on FUNCTION.
629 COMMAND is a symbol. DOC-STRING is a string.
630 FUNCTION is a function that takes one file-name or directory-name
631 argument, read as input. (Use macro `icicle-define-command' for a
632 FUNCTION whose argument is not a file or directory name.)
633
634 BINDINGS is a list of `let*' bindings added around the command code.
635 The following bindings are pre-included - you can refer to them in
636 the command body (including in FIRST-SEXP, LAST-SEXP, UNDO-SEXP).
637
638 `icicle-orig-buff' is bound to (current-buffer)
639 `icicle-orig-window' is bound to (selected-window)
640 BINDINGS is macroexpanded, so it can also be a macro call that expands
641 to a list of bindings. For example, you can use
642 `icicle-buffer-bindings' or `icicle-file-bindings' here.
643
644 In case of user quit (`C-g') or error, an attempt is made to restore
645 the original buffer.
646
647 FIRST-SEXP is a sexp evaluated before the main body of the command.
648 UNDO-SEXP is a sexp evaluated in case of error or if the user quits.
649 LAST-SEXP is a sexp evaluated after the main body of the command.
650 It is always evaluated, in particular, even in case of error or quit.
651 NOT-INTERACTIVE-P non-nil means to define COMMAND as a non-interactive
652 function that reads multi-command input.
653
654 Other arguments are as for `read-file-name'.
655
656 In order, the created command does this:
657
658 - Uses DOC-STRING, with information about Icicles bindings appended.
659 - Binds BINDINGS for the rest of the command.
660 - Evaluates FIRST-SEXP.
661 - Reads input with `read-file-name', using PROMPT, DIR,
662 DEFAULT-FILENAME, REQUIRE-MATCH, INITIAL-INPUT, and PREDICATE.
663 - Calls FUNCTION on the input that was read.
664 - Evaluates UNDO-SEXP in case of error or if the user quits.
665 - Evaluates LAST-SEXP.
666
667 The created command also binds `icicle-candidate-action-fn' to a
668 function that calls FUNCTION on the current completion candidate.
669 Note that the BINDINGS are of course not in effect within
670 `icicle-candidate-action-fn'."
671 (let ((choice (make-symbol "file-choice"))
672 (hide-common (make-symbol "hide-common-match"))
673 (no-incr-comp (make-symbol "no-incr-comp"))
674 (no-icomplete (make-symbol "no-icomplete")))
675 `(defun ,command ()
676 ,(concat doc-string "\n\nRead input, then "
677 (and (symbolp function) (concat "call `" (symbol-name function) "'\nto "))
678 "act on it.
679
680 Input-candidate completion and cycling are available. While cycling,
681 these keys with prefix `C-' are active:
682
683 \\<minibuffer-local-completion-map>\
684 `C-mouse-2', `C-return' - Act on current completion candidate only
685 `C-down', `C-wheel-down' - Move to next completion candidate and act
686 `C-up', `C-wheel-up' - Move to previous completion candidate and act
687 `C-next' - Move to next apropos-completion candidate and act
688 `C-prior' - Move to previous apropos-completion candidate and act
689 `C-end' - Move to next prefix-completion candidate and act
690 `C-home' - Move to previous prefix-completion candidate and act
691 `\\[icicle-all-candidates-action]' - Act on *all* candidates, successively (careful!)
692
693 When candidate action and cycling are combined (e.g. `C-next'), user
694 option `icicle-act-before-cycle-flag' determines which occurs first.
695
696 With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2',
697 `C-M-RET', `C-M-down', and so on) provide help about candidates.
698
699 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or
700 `C-g' to quit.
701
702 This is an Icicles command - see command `icicle-mode'.")
703 ,(and (not not-interactive-p) '(interactive))
704 (let* ((icicle-orig-buff (current-buffer))
705 (icicle-orig-window (selected-window))
706 ,@(macroexpand bindings) ; User-provided bindings.
707 (icicle-candidate-action-fn
708 (lambda (candidate)
709 (let ((minibuffer-completion-table minibuffer-completion-table)
710 (minibuffer-completion-predicate minibuffer-completion-predicate)
711 (minibuffer-completion-confirm minibuffer-completion-confirm)
712 (minibuffer-completing-file-name minibuffer-completing-file-name)
713 (minibuffer-completing-symbol (and (boundp 'minibuffer-completing-symbol)
714 minibuffer-completing-symbol))
715 (minibuffer-exit-hook minibuffer-exit-hook)
716 (minibuffer-help-form minibuffer-help-form)
717 (minibuffer-history-variable minibuffer-history-variable)
718 (minibuffer-history-case-insensitive-variables
719 minibuffer-history-case-insensitive-variables)
720 (minibuffer-history-sexp-flag minibuffer-history-sexp-flag)
721 (minibuffer-message-timeout (and (boundp 'minibuffer-message-timeout)
722 minibuffer-message-timeout))
723 (minibuffer-prompt-properties (and (boundp 'minibuffer-prompt-properties)
724 minibuffer-prompt-properties))
725 (minibuffer-setup-hook minibuffer-setup-hook)
726 (minibuffer-text-before-history minibuffer-text-before-history))
727 (setq candidate (expand-file-name candidate
728 (and icicle-last-input
729 (icicle-file-name-directory
730 (directory-file-name icicle-last-input)))))
731 (icicle-condition-case-no-debug in-action-fn
732 ;; Treat 3 cases, because previous use of `icicle-candidate-action-fn'
733 ;; might have deleted the file or the window.
734 (cond ((and (buffer-live-p icicle-orig-buff) (window-live-p icicle-orig-window))
735 (with-current-buffer icicle-orig-buff
736 (save-selected-window (select-window icicle-orig-window)
737 (funcall #',function candidate))))
738 ((window-live-p icicle-orig-window)
739 (save-selected-window (select-window icicle-orig-window)
740 (funcall #',function candidate)))
741 (t
742 (funcall #',function candidate)))
743 (error (unless (string= "Cannot switch buffers in minibuffer window"
744 (error-message-string in-action-fn))
745 (error "%s" (error-message-string in-action-fn)))
746 (when (window-live-p icicle-orig-window)
747 (select-window icicle-orig-window)
748 (select-frame-set-input-focus (selected-frame)))
749 (funcall #',function candidate)))
750 (select-window (minibuffer-window))
751 (select-frame-set-input-focus (selected-frame))
752 nil)))) ; Return nil for success.
753
754 (icicle-condition-case-no-debug catch-top-level
755 (catch 'icicle-top-level
756 (let (,hide-common ,no-incr-comp ,no-icomplete)
757 (when (and (get this-command 'icicle-hide-common-match)
758 (not icicle-hide-common-match-in-Completions-flag))
759 (setq icicle-hide-common-match-in-Completions-flag t
760 ,hide-common t))
761 (when (and (get this-command 'icicle-turn-off-incremental-completion)
762 icicle-incremental-completion)
763 (setq icicle-incremental-completion nil
764 ,no-incr-comp t))
765 (when (and (get this-command 'icicle-turn-off-icomplete-mode)
766 (featurep 'icomplete) icomplete-mode)
767 (icomplete-mode -1)
768 (setq ,no-icomplete t))
769 (when (or ,hide-common ,no-incr-comp ,no-icomplete)
770 (message "Turned OFF: %s%s%s%s%s"
771 (if ,hide-common
772 (concat (icicle-propertize "showing common match"
773 'face 'icicle-msg-emphasis)
774 " (`C-x .')")
775 "")
776 (if (and ,hide-common (or ,no-incr-comp ,no-icomplete)) ", " "")
777 (if ,no-incr-comp
778 (concat (icicle-propertize "incremental completion"
779 'face 'icicle-msg-emphasis)
780 " (`C-#')")
781 "")
782 (if (and ,no-incr-comp ,no-icomplete) ", " "")
783 (if ,no-icomplete
784 (concat (icicle-propertize "Icomplete mode"
785 'face 'icicle-msg-emphasis)
786 " (`C-M-#')")
787 ""))
788 (sit-for 3))
789 ,first-sexp
790 (icicle-condition-case-no-debug act-on-choice
791 (let ((,choice
792 (if (< emacs-major-version 21) ; No predicate arg for Emacs 20.
793 (read-file-name ,prompt ,dir ,default-filename ,require-match
794 ,initial-input)
795 (read-file-name ,prompt ,dir ,default-filename ,require-match
796 ,initial-input ,predicate))))
797 ;; Reset after reading input, so commands can tell if input has been read.
798 (setq icicle-candidate-action-fn nil) ; Reset after completion.
799 (funcall #',function ,choice))
800 (quit (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp)
801 (error (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp
802 (error "%s" (error-message-string act-on-choice)))))
803 ,last-sexp)
804 (quit (icicle-try-switch-buffer icicle-orig-buff) ,last-sexp)
805 (error (icicle-try-switch-buffer icicle-orig-buff) ,last-sexp
806 (error "%s" (error-message-string catch-top-level))))))))
807
808 (defmacro icicle-define-sort-command (sort-order comparison-fn doc-string)
809 "Define a command to sort completions by SORT-ORDER.
810 SORT-ORDER is a short string (or symbol) describing the sort order.
811 It is used after the phrase \"Sorting is now \". Examples: \"by date\",
812 \"alphabetical\", \"directories first\", and \"previously used first\".
813
814 The new command is named by replacing any spaces in SORT-ORDER with
815 hyphens (`-') and then adding the prefix `icicle-sort-'.
816
817 COMPARISON-FN is a function that compares two strings, returning
818 non-nil if and only if the first string sorts before the second.
819
820 DOC-STRING is the doc string of the new command."
821 (unless (stringp sort-order) (setq sort-order (symbol-name sort-order)))
822 (let ((command (intern (concat "icicle-sort-" (replace-regexp-in-string "\\s-+" "-" sort-order)))))
823 `(progn
824 (setq icicle-sort-orders-alist (icicle-assoc-delete-all ,sort-order icicle-sort-orders-alist))
825 (push (cons ,sort-order ',comparison-fn) icicle-sort-orders-alist)
826 (defun ,command ()
827 ,doc-string
828 (interactive)
829 (setq icicle-sort-comparer #',comparison-fn)
830 (message "Sorting is now %s" ,(icicle-propertize
831 (concat sort-order (and icicle-reverse-sort-p ", REVERSED"))
832 'face 'icicle-msg-emphasis))
833 (icicle-complete-again-update)))))
834
835 (defmacro icicle-define-bookmark-command (type &optional prompt &rest args)
836 "Define an Icicles multi-command for jumping to bookmarks of type TYPE.
837 TYPE is a string to be used for the doc string, default prompt, and in
838 function names. It should be lowercase and contain no spaces.
839 Optional arg PROMPT is the completion prompt.
840 ARGS is a list of any additional arguments to be passed to the
841 appropriate `bmkp-TYPE-alist-only' function."
842 `(icicle-define-bookmark-command-1 nil ,type ,prompt ,args))
843
844 (defmacro icicle-define-bookmark-other-window-command (type &optional prompt &rest args)
845 "Same as `icicle-define-bookmark-command', but command uses other window."
846 `(icicle-define-bookmark-command-1 t ,type ,prompt ,args))
847
848 ;; Similar to `icicle-define-search-bookmark-command'. Could combine them.
849 (defmacro icicle-define-bookmark-command-1 (otherp type prompt args)
850 "Helper macro for `icicle-define*-bookmark-command' macros.
851 The command defined raises an error unless library `Bookmark+' can be
852 loaded."
853 `(icicle-define-command
854 ,(intern (format "icicle-bookmark-%s%s" type (if otherp "-other-window" ""))) ; Command name
855 ,(format "Jump to a%s %s bookmark%s.
856 Like `icicle-bookmark%s',
857 but with %s bookmarks only.
858 This is a multi-command version of
859 `bmkp-%s-jump%s'.
860 %s
861 You need library `Bookmark+' for this command."
862 (if (memq (aref type 0) '(?a ?e ?i ?o ?u)) "n" "") ; `a' or `an'
863 type (if otherp " in other window" "")
864 (if otherp "-other-window" "") type
865 type (if otherp "-other-window" "")
866 (if (string-match "tags" type) ; Additional info about refreshing tags list.
867 "
868 By default, the tag choices for completion are NOT refreshed, to save
869 time. Use a prefix arg if you want to refresh them. For example, use
870 a prefix arg after you have switched to a different bookmark file,
871 after you have added new tags to some bookmarks, or after you have
872 completely removed some tags from all bookmarks. IOW, any time the
873 set of existing tags has changed, you might want to use a prefix arg,
874 to update the list of tags available for completion." "")) ; Doc string
875 (lambda (cand) (,(if otherp 'icicle-bookmark-jump-other-window 'icicle-bookmark-jump) ; Action fn.
876 (icicle-transform-multi-completion cand)))
877 prompt1 icicle-candidates-alist nil ; `completing-read' args
878 (not icicle-show-multi-completion-flag)
879 nil (if (boundp 'bookmark-history) 'bookmark-history 'icicle-bookmark-history)
880 nil nil
881 ((IGNORED1 (unless (require 'bookmark+ nil t) ; Additional bindings
882 (icicle-user-error
883 "You need library `Bookmark+' for this command")))
884 (IGNORED2 (bookmark-maybe-load-default-file)) ; `bookmark-alist'.
885 (enable-recursive-minibuffers t) ; In case we read input, e.g. File changed on disk...
886 (bmk-alist (bmkp-sort-omit
887 (funcall ',(intern (format "bmkp-%s-alist-only" type))
888 ,@args)))
889 (completion-ignore-case bookmark-completion-ignore-case)
890 (prompt1 ,(or prompt (format "%s%s bookmark: "
891 (capitalize (substring type 0 1))
892 (substring type 1 (length type)))))
893 (icicle-multi-completing-p icicle-show-multi-completion-flag)
894 (icicle-bookmark-completing-p t)
895 (icicle-list-use-nth-parts '(1))
896 (icicle-candidate-properties-alist (if (not icicle-show-multi-completion-flag)
897 ()
898 '((2 (face icicle-annotation))
899 (3 (face icicle-msg-emphasis)))))
900 (icicle-transform-function (and (not (interactive-p)) icicle-transform-function))
901 (icicle-whole-candidate-as-text-prop-p t)
902 (icicle-transform-before-sort-p t)
903 (icicle-delete-candidate-object 'icicle-bookmark-delete-action)
904 ;; This binding is for `icicle-autofile-action', in `icicle-bind-file-candidate-keys'.
905 (icicle-full-cand-fn (and (equal ,type "autofile")
906 #'icicle-make-bookmark-candidate))
907 (icicle-candidates-alist (mapcar #'icicle-make-bookmark-candidate bmk-alist))
908 (icicle-sort-orders-alist
909 (append
910 '(("in *Bookmark List* order") ; Renamed from "turned OFF'.
911 ("by bookmark name" . icicle-alpha-p)
912 ("by last bookmark access" (bmkp-bookmark-last-access-cp) icicle-alpha-p)
913 ("by bookmark visit frequency" (bmkp-visited-more-cp) icicle-alpha-p))
914 (and (member ,type '("info" "region"))
915 '(("by Info location" (bmkp-info-cp) icicle-alpha-p)))
916 (and (member ,type '("gnus" "region"))
917 '(("by Gnus thread" (bmkp-gnus-cp) icicle-alpha-p)))
918 (and (member ,type '("url" "region"))
919 '(("by URL" (bmkp-url-cp) icicle-alpha-p)))
920 (and (not (member ,type '("bookmark-list" "desktop" "gnus" "info" "man" "url")))
921 '(("by bookmark type" (bmkp-info-cp bmkp-url-cp bmkp-gnus-cp
922 bmkp-local-file-type-cp bmkp-handler-cp)
923 icicle-alpha-p)))
924 (and (not (member ,type '("bookmark-list" "desktop" "dired" "non-file")))
925 '(("by file name" (bmkp-file-alpha-cp) icicle-alpha-p)))
926 (and (member ,type '("local-file" "file" "dired" "region"))
927 '(("by local file type" (bmkp-local-file-type-cp) icicle-alpha-p)
928 ("by local file size" (bmkp-local-file-size-cp) icicle-alpha-p)
929 ("by last local file access" (bmkp-local-file-accessed-more-recently-cp)
930 icicle-alpha-p)
931 ("by last local file update" (bmkp-local-file-updated-more-recently-cp)
932 icicle-alpha-p)))
933 (and (not (string= ,type "desktop"))
934 '(("by last buffer or file access" (bmkp-buffer-last-access-cp
935 bmkp-local-file-accessed-more-recently-cp)
936 icicle-alpha-p)))
937 (and (get-buffer "*Bookmark List*")
938 '(("marked before unmarked (in *Bookmark List*)" (bmkp-marked-cp)
939 icicle-alpha-p)))
940 '(("by previous use alphabetically" . icicle-historical-alphabetic-p)
941 ("case insensitive" . icicle-case-insensitive-string-less-p))))
942 (icicle-candidate-help-fn
943 (lambda (cand)
944 (when icicle-show-multi-completion-flag
945 (setq cand (funcall icicle-get-alist-candidate-function cand))
946 (setq cand (cons (caar cand) (cdr cand))))
947 (if current-prefix-arg
948 (bmkp-describe-bookmark-internals cand)
949 (bmkp-describe-bookmark cand)))))
950 (when (equal ,type "autofile") (icicle-bind-file-candidate-keys)) ; First code
951 (icicle-bookmark-cleanup-on-quit) ; Undo code
952 (progn (when (equal ,type "autofile") (icicle-unbind-file-candidate-keys))
953 (icicle-bookmark-cleanup)))) ; Last code
954
955 ;; Similar to `icicle-define-bookmark-command-1'. Could combine them.
956 (defmacro icicle-define-search-bookmark-command (type &optional prompt &rest args)
957 "Define Icicles multi-command for searching bookmarks of type TYPE.
958 TYPE is a string to be used for the doc string, default prompt, and in
959 function names. It should be lowercase and contain no spaces.
960 Optional arg PROMPT is the completion prompt.
961 ARGS is a list of any additional arguments to be passed to the
962 appropriate `bmkp-TYPE-alist-only' function.
963
964 The command defined raises an error unless library `Bookmark+' can be
965 loaded."
966 `(icicle-define-command
967 ,(intern (format "icicle-search-%s-bookmark" type)) ; Command name
968 ,(format "Search %s bookmark text.
969 Like `icicle-search-bookmark', but with %s bookmarks only.
970 You need library `Bookmark+' for this command." type type) ; Doc string
971 icicle-search-bookmark-action ; Action function
972 prompt1 icicle-candidates-alist nil ; `completing-read' args
973 (not icicle-show-multi-completion-flag)
974 nil (if (boundp 'bookmark-history) 'bookmark-history 'icicle-bookmark-history)
975 nil nil
976 ((IGNORED1 (unless (require 'bookmark+ nil t) ; Bindings
977 (icicle-user-error
978 "You need library `Bookmark+' for this command")))
979 (IGNORED2 (bookmark-maybe-load-default-file)) ; `bookmark-alist'.
980 (enable-recursive-minibuffers t) ; In case we read input, e.g. File changed on...
981 (completion-ignore-case bookmark-completion-ignore-case)
982 (prompt1 ,(or prompt (format "Search %s bookmark: " type)))
983 (icicle-multi-completing-p icicle-show-multi-completion-flag)
984 (icicle-bookmark-completing-p t)
985 (icicle-list-use-nth-parts '(1))
986 (icicle-candidate-properties-alist (if (not icicle-show-multi-completion-flag)
987 ()
988 '((2 (face icicle-annotation))
989 (3 (face icicle-msg-emphasis)))))
990 (icicle-transform-function (and (not (interactive-p)) icicle-transform-function))
991 (icicle-whole-candidate-as-text-prop-p t)
992 (icicle-transform-before-sort-p t)
993 (icicle-delete-candidate-object 'icicle-bookmark-delete-action)
994 ;; This binding is for `icicle-autofile-action', in `icicle-bind-file-candidate-keys'.
995 (icicle-full-cand-fn (and (equal ,type "autofile")
996 #'icicle-make-bookmark-candidate))
997 (icicle-candidates-alist (mapcar #'icicle-make-bookmark-candidate
998 (bmkp-sort-omit
999 (funcall ',(intern (format "bmkp-%s-alist-only" type))
1000 ,@args))))
1001 (regexp (icicle-search-read-context-regexp
1002 ,(format
1003 "Search %s bookmarks %swithin contexts (regexp): "
1004 type
1005 (if icicle-search-complement-domain-p "*NOT* " ""))))
1006 (bookmark-automatically-show-annotations nil) ; Do not show annotations
1007 (icicle-sort-orders-alist
1008 (append
1009 '(("in *Bookmark List* order") ; Renamed from "turned OFF'.
1010 ("by bookmark name" . icicle-alpha-p)
1011 ("by last bookmark access" (bmkp-bookmark-last-access-cp) icicle-alpha-p)
1012 ("by bookmark visit frequency" (bmkp-visited-more-cp) icicle-alpha-p))
1013 (and (member ,type '("info" "region"))
1014 '(("by Info location" (bmkp-info-cp) icicle-alpha-p)))
1015 (and (member ,type '("gnus" "region"))
1016 '(("by Gnus thread" (bmkp-gnus-cp) icicle-alpha-p)))
1017 (and (member ,type '("url" "region"))
1018 '(("by URL" (bmkp-url-cp) icicle-alpha-p)))
1019 (and (not (member ,type '("bookmark-list" "desktop" "gnus" "info" "man" "url")))
1020 '(("by bookmark type" (bmkp-info-cp bmkp-url-cp bmkp-gnus-cp
1021 bmkp-local-file-type-cp bmkp-handler-cp)
1022 icicle-alpha-p)))
1023 (and (not (member ,type '("bookmark-list" "desktop" "dired" "non-file")))
1024 '(("by file name" (bmkp-file-alpha-cp) icicle-alpha-p)))
1025 (and (member ,type '("local-file" "file" "dired" "region"))
1026 '(("by local file type" (bmkp-local-file-type-cp) icicle-alpha-p)
1027 ("by local file size" (bmkp-local-file-size-cp) icicle-alpha-p)
1028 ("by last local file access" (bmkp-local-file-accessed-more-recently-cp)
1029 icicle-alpha-p)
1030 ("by last local file update" (bmkp-local-file-updated-more-recently-cp)
1031 icicle-alpha-p)))
1032 (and (not (string= ,type "desktop"))
1033 '(("by last buffer or file access" (bmkp-buffer-last-access-cp
1034 bmkp-local-file-accessed-more-recently-cp)
1035 icicle-alpha-p)))
1036 (and (get-buffer "*Bookmark List*")
1037 '(("marked before unmarked (in *Bookmark List*)" (bmkp-marked-cp)
1038 icicle-alpha-p)))
1039 '(("by previous use alphabetically" . icicle-historical-alphabetic-p)
1040 ("case insensitive" . icicle-case-insensitive-string-less-p))))
1041 (icicle-candidate-help-fn
1042 (lambda (cand)
1043 (when icicle-show-multi-completion-flag
1044 (setq cand (funcall icicle-get-alist-candidate-function cand))
1045 (setq cand (cons (caar cand) (cdr cand))))
1046 (if current-prefix-arg
1047 (bmkp-describe-bookmark-internals cand)
1048 (bmkp-describe-bookmark cand)))))
1049 (when (equal ,type "autofile") (icicle-bind-file-candidate-keys)) ; First code
1050 (icicle-bookmark-cleanup-on-quit) ; Undo code
1051 (progn (when (equal ,type "autofile") (icicle-unbind-file-candidate-keys))
1052 (icicle-bookmark-cleanup)))) ; Last code
1053
1054 ;; Same as `bmkp-menu-bar-make-toggle' in `bookmark+-mac.el'.
1055 (defmacro icicle-menu-bar-make-toggle (name variable doc message help &rest body)
1056 "Return a valid `menu-bar-make-toggle' call in Emacs 20 or later.
1057 NAME is the name of the toggle command to define.
1058 VARIABLE is the variable to set.
1059 DOC is the menu-item name.
1060 MESSAGE is the toggle message, minus status.
1061 HELP is `:help' string.
1062 BODY is the function body to use. If present, it is responsible for
1063 setting the variable and displaying a status message (not MESSAGE)."
1064 (if (< emacs-major-version 21)
1065 `(menu-bar-make-toggle ,name ,variable ,doc ,message ,@body)
1066 `(menu-bar-make-toggle ,name ,variable ,doc ,message ,help ,@body)))
1067
1068 (defmacro icicle-with-help-window (buffer &rest body)
1069 "`with-help-window', if available; else `with-output-to-temp-buffer'."
1070 (if (fboundp 'with-help-window)
1071 `(with-help-window ,buffer ,@body)
1072 `(with-output-to-temp-buffer ,buffer ,@body)))
1073
1074 (defmacro icicle-with-icy-mode-OFF (&rest body)
1075 "Turn off `icicle-mode' for the evaluation of BODY forms.
1076 The current value of `icicle-mode' before evaluating the forms is
1077 restored after their evaluation. It is also restored in case of error
1078 or other non-local exit."
1079 (let ((g-orig (make-symbol "orig-val-icicle-mode")))
1080 `(let ((,g-orig icicle-mode))
1081 (unwind-protect (progn (when icicle-mode (icy-mode -1)) ,@body)
1082 (when ,g-orig (icy-mode 1)))))) ; No-op if it was already off.
1083
1084 (defmacro icicle-with-icy-mode-ON (&rest body)
1085 "Turn on `icicle-mode' for the evaluation of BODY forms.
1086 The current value of `icicle-mode' before evaluating the forms is
1087 restored after their evaluation. It is also restored in case of error
1088 or other non-local exit."
1089 (let ((g-orig (make-symbol "orig-val-icicle-mode")))
1090 `(let ((,g-orig icicle-mode))
1091 (unwind-protect (progn (unless icicle-mode (icy-mode 1)) ,@body)
1092 (unless ,g-orig (icy-mode -1)))))) ; No-op if it was already off.
1093
1094 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1095
1096 (provide 'icicles-mac)
1097
1098 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1099 ;;; icicles-mac.el ends here