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