1 ;;; icicles-mac.el --- Macros for Icicles
3 ;; Filename: icicles-mac.el
4 ;; Description: Macros for Icicles
6 ;; Maintainer: Drew Adams
7 ;; Copyright (C) 1996-2011, Drew Adams, all rights reserved.
8 ;; Created: Mon Feb 27 09:24:28 2006
10 ;; Last-Updated: Thu Sep 8 13:35:20 2011 (-0700)
13 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/icicles-mac.el
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
18 ;; Features that might be required by this library:
22 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
26 ;; This is a helper library for library `icicles.el'. It defines
27 ;; macros. For Icicles documentation, see `icicles-doc1.el' and
30 ;; User options defined here (in Custom group `Icicles'):
32 ;; `icicle-byte-compile-eval-after-load-flag'.
34 ;; Macros defined here:
36 ;; `icicle-buffer-bindings', `icicle-condition-case-no-debug',
37 ;; `icicle-define-add-to-alist-command', `icicle-define-command',
38 ;; `icicle-define-file-command', `icicle-define-sort-command',
39 ;; `icicle-file-bindings', `icicle-maybe-byte-compile-after-load',
40 ;; `icicle-with-selected-window'.
42 ;; Functions defined here:
44 ;; `icicle-assoc-delete-all', `icicle-try-switch-buffer'.
46 ;; Standard Emacs function defined here for older Emacs versions:
48 ;; `select-frame-set-input-focus'.
50 ;; You might also be interested in my library `imenu+.el', which
51 ;; teaches the macros defined here to Imenu, so the functions defined
52 ;; with those macros show up in Imenu menus.
54 ;; I've also included some commented-out code at the end, which you
55 ;; might want to use in your init file (~/.emacs). It provides
56 ;; better indentation for the doc string when you use the macros here
59 ;; For descriptions of changes to this file, see `icicles-chg.el'.
62 ;; NOTE: Whenever you update Icicles (i.e., download new versions of
63 ;; Icicles source files), I recommend that you do the following:
65 ;; 1. Delete all existing byte-compiled Icicles files
67 ;; 2. Load Icicles (`load-library' or `require').
68 ;; 3. Byte-compile the source files.
70 ;; In particular, always load `icicles-mac.el' (not
71 ;; `icicles-mac.elc') before you byte-compile new versions of the
72 ;; files, in case there have been any changes to Lisp macros (in
78 ;; If you have library `linkd.el' and Emacs 22 or later, load
79 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
80 ;; navigate around the sections of this doc. Linkd mode will
81 ;; highlight this Index, as well as the cross-references and section
82 ;; headings throughout this file. You can get `linkd.el' here:
83 ;; http://dto.freeshell.org/notebook/Linkd.html.
85 ;; (@> "User Options")
89 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
91 ;; This program is free software; you can redistribute it and/or modify
92 ;; it under the terms of the GNU General Public License as published by
93 ;; the Free Software Foundation; either version 3, or (at your option)
96 ;; This program is distributed in the hope that it will be useful,
97 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
98 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
99 ;; GNU General Public License for more details.
101 ;; You should have received a copy of the GNU General Public License
102 ;; along with this program; see the file COPYING. If not, write to the
103 ;; Free Software Foundation, Inc., 51 Franklin Street,
104 ;; Fifth Floor, Boston, MA 02110-1301, USA.
106 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
110 ;; Byte-compiling this file, you will likely get some error or warning
111 ;; messages. All of the following are benign. They are due to
112 ;; differences between different versions of Emacs.
114 ;; Compiling in Emacs 20:
116 ;; the function x-focus-frame is not known to be defined.
118 (eval-when-compile (when (< emacs-major-version 21) (require 'cl))) ;; for Emacs < 21: dolist, push
120 ;; Quiet the byte compiler for Emacs versions before 22. For some reason, a value is required.
121 (unless (boundp 'minibuffer-completing-symbol)
122 (defvar minibuffer-completing-symbol nil)
123 (defvar minibuffer-message-timeout 2)
124 (defvar minibuffer-prompt-properties nil))
126 ;; Quiet the byte-compiler.
127 (defvar icicle-inhibit-try-switch-buffer)
128 (defvar read-file-name-completion-ignore-case)
130 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
132 ;;(@* "User Options")
134 ;;; User Options -----------------------------------------------------
137 (defcustom icicle-byte-compile-eval-after-load-flag t
138 "*Non-nil means byte-compile definitions made within `eval-after-load'.
139 Some Icicles functions (commands, in particular) work only if a given
140 library is loaded. Some such functions are defined inside an
141 `eval-after-load' form, which means they are defined only, and as soon
142 as, the required library is loaded.
144 If this option is non-nil then those function definitions are
145 byte-compiled. This compilation adds a bit to the load time, in
146 effect, but it means that the functions run faster."
147 :type 'boolean :group 'Icicles-Miscellaneous)
151 ;;; Macros -----------------------------------------------------------
154 ;; Same as vanilla `condition-case-no-debug', which is available starting with Emacs 23.
155 ;; (defmacro icicle-condition-case-no-debug (var bodyform &rest handlers)
156 ;; "Like `condition-case', but does not catch anything when debugging.
157 ;; Specifically, non-nil `debug-on-error' means catch no signals.
158 ;; This is the same as `condition-case-no-debug': added to use in older
159 ;; Emacs versions too."
160 ;; (let ((bodysym (make-symbol "body")))
161 ;; `(let ((,bodysym (lambda () ,bodyform)))
162 ;; (if debug-on-error
163 ;; (funcall ,bodysym)
164 ;; (condition-case ,var
165 ;; (funcall ,bodysym)
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'.
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.
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').
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)'.
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)
197 (lambda (hh) (memq (car hh) '(error quit)))
203 (lambda (hh) (eq (car hh) 'error))
209 (lambda (hh) (eq (car hh) 'quit))
216 (defmacro icicle-maybe-byte-compile-after-load (function)
217 "Byte-compile FUNCTION if `icicle-byte-compile-eval-after-load-flag'.
218 Do nothing if FUNCTION has not been defined (`fboundp')."
219 `(when (and icicle-byte-compile-eval-after-load-flag (fboundp ',function))
221 (let ((byte-compile-warnings ())
222 (byte-compile-verbose nil))
223 (byte-compile ',function))))
225 (if (fboundp 'with-selected-window) ; Emacs 22+
226 (defalias 'icicle-with-selected-window (symbol-function 'with-selected-window))
227 (defmacro icicle-with-selected-window (window &rest body)
228 "Execute the forms in BODY with WINDOW as the selected window.
229 The value returned is the value of the last form in BODY.
231 This macro saves and restores the selected window, as well as the
232 selected window of each frame. It does not change the order of
233 recently selected windows. If the previously selected window of
234 some frame is no longer live at the end of BODY, that frame's
235 selected window is left alone. If the selected window is no
236 longer live, then whatever window is selected at the end of BODY
239 This macro uses `save-current-buffer' to save and restore the
240 current buffer, since otherwise its normal operation could
241 potentially make a different buffer current. It does not alter
242 the buffer list ordering."
243 ;; Most of this code is a copy of save-selected-window.
244 `(let ((save-selected-window-window (selected-window))
245 ;; It is necessary to save all of these, because calling
246 ;; select-window changes frame-selected-window for whatever
247 ;; frame that window is in.
248 (save-selected-window-alist (mapcar #'(lambda (frame)
249 (list frame (frame-selected-window frame)))
253 (progn (if (> emacs-major-version 21)
254 (select-window ,window 'norecord) ; Emacs 22+
255 (select-window ,window))
257 (dolist (elt save-selected-window-alist)
258 (and (frame-live-p (car elt))
259 (window-live-p (cadr elt))
260 (if (> emacs-major-version 22)
261 (set-frame-selected-window (car elt) (cadr elt) 'norecord) ; Emacs 23+
262 (set-frame-selected-window (car elt) (cadr elt)))))
263 (when (window-live-p save-selected-window-window)
264 (if (> emacs-major-version 21)
265 (select-window save-selected-window-window 'norecord) ; Emacs 22+
266 (select-window save-selected-window-window))))))))
269 (defmacro icicle-define-add-to-alist-command (command doc-string construct-item-fn alist-var
271 "Define COMMAND that adds an item to an alist user option.
272 Any items with the same key are first removed from the alist.
273 DOC-STRING is the doc string of COMMAND.
274 CONSTRUCT-ITEM-FN is a function that constructs the new item.
276 ALIST-VAR is the alist user option.
277 Optional arg DONT-SAVE non-nil means do not call
278 `customize-save-variable' to save the updated variable."
280 ,(concat doc-string "\n\nNote: Any items with the same key are first removed from the alist.")
282 (let ((new-item (funcall ,construct-item-fn)))
283 (setq ,alist-var (icicle-assoc-delete-all (car new-item) ,alist-var))
284 (push new-item ,alist-var)
285 ,(unless dont-save `(customize-save-variable ',alist-var ,alist-var))
286 (message "Added to `%s': `%S'" ',alist-var new-item))))
288 (defmacro icicle-buffer-bindings (&optional pre-bindings post-bindings)
289 "Bindings to use in multi-command definitions for buffer names.
290 PRE-BINDINGS is a list of additional bindings, which are created
291 before the others. POST-BINDINGS is similar, but the bindings are
292 created after the others."
293 ;; We use `append' rather than backquote syntax (with ,@post-bindings in particular) because of a bug
294 ;; in Emacs 20. This ensures that you can byte-compile in, say, Emacs 20 and still use the result
295 ;; in later Emacs releases.
298 `((completion-ignore-case (or (and (boundp 'read-buffer-completion-ignore-case)
299 read-buffer-completion-ignore-case)
300 completion-ignore-case))
301 (icicle-show-Completions-initially-flag (or icicle-show-Completions-initially-flag
302 icicle-buffers-ido-like-flag))
303 (icicle-top-level-when-sole-completion-flag (or icicle-top-level-when-sole-completion-flag
304 icicle-buffers-ido-like-flag))
305 (icicle-default-value (if (and icicle-buffers-ido-like-flag
306 icicle-default-value)
307 icicle-buffers-ido-like-flag
308 icicle-default-value))
309 (icicle-must-match-regexp icicle-buffer-match-regexp)
310 (icicle-must-not-match-regexp icicle-buffer-no-match-regexp)
311 (icicle-must-pass-after-match-predicate icicle-buffer-predicate)
312 (icicle-require-match-flag icicle-buffer-require-match-flag)
313 (icicle-extra-candidates icicle-buffer-extras)
314 (icicle-ignore-space-prefix-flag icicle-buffer-ignore-space-prefix-flag)
315 (icicle-delete-candidate-object 'icicle-kill-a-buffer) ; `S-delete' kills current buf
316 (icicle-transform-function 'icicle-remove-dups-if-extras)
319 '("by last access") ; Renamed from "turned OFF'.
320 '("*...* last" . icicle-buffer-sort-*...*-last)
321 '("by buffer size" . icicle-buffer-smaller-p)
322 '("by major mode name" . icicle-major-mode-name-less-p)
323 (and (fboundp 'icicle-mode-line-name-less-p)
324 '("by mode-line mode name" . icicle-mode-line-name-less-p))
325 '("by file/process name" . icicle-buffer-file/process-name-less-p))
326 (delete '("turned OFF") (copy-sequence icicle-sort-orders-alist))))
327 ;; Put `icicle-buffer-sort' first. If already in the list, move it, else add it, to beginning.
328 (icicle-sort-orders-alist
329 (progn (when (and icicle-buffer-sort-first-time-p icicle-buffer-sort)
330 (setq icicle-sort-comparer icicle-buffer-sort
331 icicle-buffer-sort-first-time-p nil))
332 (if icicle-buffer-sort
333 (let ((already-there (rassq icicle-buffer-sort icicle--temp-orders)))
335 (cons already-there (setq icicle--temp-orders
336 (delete already-there icicle--temp-orders)))
337 (cons `("by `icicle-buffer-sort'" . ,icicle-buffer-sort) icicle--temp-orders)))
338 icicle--temp-orders)))
339 (icicle-candidate-alt-action-fn
340 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "buffer")))
341 (icicle-all-candidates-list-alt-action-fn
342 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "buffer")))
344 (if current-prefix-arg
345 (cond ((zerop (prefix-numeric-value current-prefix-arg))
346 (let ((this-mode major-mode))
347 (icicle-remove-if-not #'(lambda (bf)
348 (with-current-buffer bf (eq major-mode this-mode)))
350 ((< (prefix-numeric-value current-prefix-arg) 0)
351 (cdr (assq 'buffer-list (frame-parameters))))
353 (icicle-remove-if-not #'(lambda (bf) (buffer-file-name bf)) (buffer-list))))
357 (defmacro icicle-file-bindings (&optional pre-bindings post-bindings)
358 "Bindings to use in multi-command definitions for file names.
359 PRE-BINDINGS is a list of additional bindings, which are created
360 before the others. POST-BINDINGS is similar, but the bindings are
361 created after the others."
362 ;; We use `append' rather than backquote syntax (with ,@post-bindings in particular) because of a bug
363 ;; in Emacs 20. This ensures that you can byte-compile in, say, Emacs 20 and still use the result
364 ;; in later Emacs releases.
367 `((completion-ignore-case
368 (or (and (boundp 'read-file-name-completion-ignore-case) read-file-name-completion-ignore-case)
369 completion-ignore-case))
370 (icicle-show-Completions-initially-flag (or icicle-show-Completions-initially-flag
371 icicle-files-ido-like-flag))
372 (icicle-top-level-when-sole-completion-flag (or icicle-top-level-when-sole-completion-flag
373 icicle-files-ido-like-flag))
374 (icicle-default-value (if (and icicle-files-ido-like-flag
375 icicle-default-value)
376 icicle-files-ido-like-flag
377 ;; Get default via `M-n', but do not insert it.
378 (and (memq icicle-default-value '(t nil))
379 icicle-default-value)))
380 (icicle-must-match-regexp icicle-file-match-regexp)
381 (icicle-must-not-match-regexp icicle-file-no-match-regexp)
382 (icicle-must-pass-after-match-predicate icicle-file-predicate)
383 (icicle-require-match-flag icicle-file-require-match-flag)
384 (icicle-extra-candidates icicle-file-extras)
385 (icicle-transform-function 'icicle-remove-dups-if-extras)
386 ;; Put `icicle-file-sort' first. If already in the list, move it, else add it, to beginning.
387 (icicle--temp-orders (copy-sequence icicle-sort-orders-alist))
388 (icicle-sort-orders-alist
389 (progn (when (and icicle-file-sort-first-time-p icicle-file-sort)
390 (setq icicle-sort-comparer icicle-file-sort
391 icicle-file-sort-first-time-p nil))
393 (let ((already-there (rassq icicle-file-sort icicle--temp-orders)))
395 (cons already-there (setq icicle--temp-orders
396 (delete already-there icicle--temp-orders)))
397 (cons `("by `icicle-file-sort'" ,@icicle-file-sort) icicle--temp-orders)))
398 icicle--temp-orders)))
399 (icicle-candidate-help-fn #'(lambda (cand)
400 (icicle-describe-file cand current-prefix-arg)))
401 (icicle-candidate-alt-action-fn
402 (or icicle-candidate-alt-action-fn (icicle-alt-act-fn-for-type "file")))
403 (icicle-all-candidates-list-alt-action-fn
404 (or icicle-all-candidates-list-alt-action-fn (icicle-alt-act-fn-for-type "file")))
405 (icicle-delete-candidate-object 'icicle-delete-file-or-directory))
409 (defmacro icicle-define-command
410 (command doc-string function prompt collection &optional
411 predicate require-match initial-input hist def inherit-input-method
412 bindings first-sexp undo-sexp last-sexp not-interactive-p)
413 ;; Hard-code these in doc string, because \\[...] prefers ASCII
414 ;; `C-RET' instead of `\\[icicle-candidate-action]'
415 ;; `C-down' instead of `\\[icicle-next-candidate-per-mode-action]'
416 ;; `C-up', `C-wheel-up' instead of `\\[icicle-previous-candidate-per-mode-action]'
417 ;; `C-next' instead of `\\[icicle-next-apropos-candidate-action]'
418 ;; `C-prior' instead of `\\[icicle-previous-apropos-candidate-action]'
419 ;; `C-end' instead of `\\[icicle-next-prefix-candidate-action]'
420 ;; `C-home' instead of `\\[icicle-previous-prefix-candidate-action]'
421 "Define COMMAND with DOC-STRING based on FUNCTION.
422 COMMAND is a symbol. DOC-STRING is a string.
423 FUNCTION is a function that takes one argument, read as input.
424 (If the argument to FUNCTION is a file name or directory name, then
425 use macro `icicle-define-file-command', instead.)
427 BINDINGS is a list of `let*' bindings added around the command code.
428 The following bindings are pre-included - you can refer to them in
429 the command body (including in FIRST-SEXP, LAST-SEXP, UNDO-SEXP).
431 `icicle-orig-buff' is bound to (current-buffer)
432 `icicle-orig-window' is bound to (selected-window)
433 BINDINGS is macroexpanded, so it can also be a macro call that expands
434 to a list of bindings. For example, you can use
435 `icicle-buffer-bindings' here.
437 In case of user quit (`C-g') or error, an attempt is made to restore
440 FIRST-SEXP is a sexp evaluated before the main body of the command.
441 UNDO-SEXP is a sexp evaluated in case of error or if the user quits.
442 LAST-SEXP is a sexp evaluated after the main body of the command.
443 It is always evaluated, in particular, even in case of error or quit.
444 NOT-INTERACTIVE-P non-nil means to define COMMAND as a non-interactive
445 function that reads multi-command input.
447 Other arguments are as for `completing-read'.
449 In order, the created command does this:
451 - Uses DOC-STRING, with information about Icicles bindings appended.
452 - Binds BINDINGS for the rest of the command.
453 - Evaluates FIRST-SEXP.
454 - Reads input with `completing-read', using PROMPT, COLLECTION,
455 PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HIST, DEF, and
456 INHERIT-INPUT-METHOD.
457 - Calls FUNCTION on the input that was read.
458 - Evaluates UNDO-SEXP in case of error or if the user quits.
459 - Evaluates LAST-SEXP.
461 The created command also binds `icicle-candidate-action-fn' to a
462 function that calls FUNCTION on the current completion candidate.
463 Note that the BINDINGS are of course not in effect within
464 `icicle-candidate-action-fn'."
466 ,(concat doc-string "\n\nRead input, then "
467 (and (symbolp function) (concat "call `" (symbol-name function) "'\nto "))
470 Input-candidate completion and cycling are available. While cycling,
471 these keys with prefix `C-' are active:
473 \\<minibuffer-local-completion-map>\
474 `C-mouse-2', `C-RET' - Act on current completion candidate only
475 `C-down', `C-wheel-down' - Move to next completion candidate and act
476 `C-up', `C-wheel-up' - Move to previous completion candidate and act
477 `C-next' - Move to next apropos-completion candidate and act
478 `C-prior' - Move to previous apropos-completion candidate and act
479 `C-end' - Move to next prefix-completion candidate and act
480 `C-home' - Move to previous prefix-completion candidate and act
481 `\\[icicle-all-candidates-action]' - Act on *all* candidates, successively (careful!)
483 When candidate action and cycling are combined (e.g. `C-next'), user
484 option `icicle-act-before-cycle-flag' determines which occurs first.
486 With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2',
487 `C-M-RET', `C-M-down', and so on) provide help about candidates.
489 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or
492 This is an Icicles command - see command `icicle-mode'.")
493 ,(and (not not-interactive-p) '(interactive))
494 (let* ((icicle-orig-buff (current-buffer))
495 (icicle-orig-window (selected-window))
496 ,@(macroexpand bindings)
497 (icicle-candidate-action-fn
499 (let ((minibuffer-completion-table minibuffer-completion-table)
500 (minibuffer-completion-predicate minibuffer-completion-predicate)
501 (minibuffer-completion-confirm minibuffer-completion-confirm)
502 (minibuffer-completing-file-name minibuffer-completing-file-name)
503 (minibuffer-completing-symbol (and (boundp 'minibuffer-completing-symbol)
504 minibuffer-completing-symbol))
505 (minibuffer-exit-hook minibuffer-exit-hook)
506 (minibuffer-help-form minibuffer-help-form)
507 (minibuffer-history-variable minibuffer-history-variable)
508 (minibuffer-history-case-insensitive-variables
509 minibuffer-history-case-insensitive-variables)
510 (minibuffer-history-sexp-flag minibuffer-history-sexp-flag)
511 (minibuffer-message-timeout (and (boundp 'minibuffer-message-timeout)
512 minibuffer-message-timeout))
513 (minibuffer-prompt-properties (and (boundp 'minibuffer-prompt-properties)
514 minibuffer-prompt-properties))
515 (minibuffer-setup-hook minibuffer-setup-hook)
516 (minibuffer-text-before-history minibuffer-text-before-history))
517 (icicle-condition-case-no-debug in-action-fn
518 ;; Treat 3 cases, because previous use of `icicle-candidate-action-fn'
519 ;; might have killed the buffer or deleted the window.
520 (cond ((and (buffer-live-p icicle-orig-buff) (window-live-p icicle-orig-window))
521 (with-current-buffer icicle-orig-buff
522 (save-selected-window (select-window icicle-orig-window)
523 (funcall #',function candidate))))
524 ((window-live-p icicle-orig-window)
525 (save-selected-window (select-window icicle-orig-window)
526 (funcall #',function candidate)))
528 (funcall #',function candidate)))
529 (error (unless (string= "Cannot switch buffers in minibuffer window"
530 (error-message-string in-action-fn))
531 (error "%s" (error-message-string in-action-fn)))
532 (when (window-live-p icicle-orig-window)
533 (select-window icicle-orig-window)
534 (select-frame-set-input-focus (selected-frame)))
535 (funcall #',function candidate)))
536 (select-window (minibuffer-window))
537 (select-frame-set-input-focus (selected-frame))
538 nil)))) ; Return nil for success.
540 (icicle-condition-case-no-debug act-on-choice
541 (let ((cmd-choice (completing-read ,prompt ,collection ,predicate ,require-match
542 ,initial-input ,hist ,def ,inherit-input-method)))
543 ;; Reset after reading input, so that commands can tell whether input has been read.
544 (setq icicle-candidate-action-fn nil)
545 (funcall #',function cmd-choice))
546 (quit (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp)
547 (error (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp
548 (error "%s" (error-message-string act-on-choice))))
552 (defmacro icicle-define-file-command
553 (command doc-string function prompt &optional
554 dir default-filename require-match initial-input predicate
555 bindings first-sexp undo-sexp last-sexp not-interactive-p)
556 ;; Hard-code these in doc string, because \\[...] prefers ASCII
557 ;; `C-RET' instead of `\\[icicle-candidate-action]'
558 ;; `C-down' instead of `\\[icicle-next-candidate-per-mode-action]'
559 ;; `C-up', `C-wheel-up' instead of `\\[icicle-previous-candidate-per-mode-action]'
560 ;; `C-next' instead of `\\[icicle-next-apropos-candidate-action]'
561 ;; `C-prior' instead of `\\[icicle-previous-apropos-candidate-action]'
562 ;; `C-end' instead of `\\[icicle-next-prefix-candidate-action]'
563 ;; `C-home' instead of `\\[icicle-previous-prefix-candidate-action]'
564 "Define COMMAND with DOC-STRING based on FUNCTION.
565 COMMAND is a symbol. DOC-STRING is a string.
566 FUNCTION is a function that takes one file-name or directory-name
567 argument, read as input. (Use macro `icicle-define-command' for a
568 FUNCTION whose argument is not a file or directory name.)
570 BINDINGS is a list of `let*' bindings added around the command code.
571 The following bindings are pre-included - you can refer to them in
572 the command body (including in FIRST-SEXP, LAST-SEXP, UNDO-SEXP).
574 `icicle-orig-buff' is bound to (current-buffer)
575 `icicle-orig-window' is bound to (selected-window)
576 BINDINGS is macroexpanded, so it can also be a macro call that expands
577 to a list of bindings. For example, you can use
578 `icicle-buffer-bindings' or `icicle-file-bindings' here.
580 In case of user quit (`C-g') or error, an attempt is made to restore
583 FIRST-SEXP is a sexp evaluated before the main body of the command.
584 UNDO-SEXP is a sexp evaluated in case of error or if the user quits.
585 LAST-SEXP is a sexp evaluated after the main body of the command.
586 It is always evaluated, in particular, even in case of error or quit.
587 NOT-INTERACTIVE-P non-nil means to define COMMAND as a non-interactive
588 function that reads multi-command input.
590 Other arguments are as for `read-file-name'.
592 In order, the created command does this:
594 - Uses DOC-STRING, with information about Icicles bindings appended.
595 - Binds BINDINGS for the rest of the command.
596 - Evaluates FIRST-SEXP.
597 - Reads input with `read-file-name', using PROMPT, DIR,
598 DEFAULT-FILENAME, REQUIRE-MATCH, INITIAL-INPUT, and PREDICATE.
599 - Calls FUNCTION on the input that was read.
600 - Evaluates UNDO-SEXP in case of error or if the user quits.
601 - Evaluates LAST-SEXP.
603 The created command also binds `icicle-candidate-action-fn' to a
604 function that calls FUNCTION on the current completion candidate.
605 Note that the BINDINGS are of course not in effect within
606 `icicle-candidate-action-fn'."
608 ,(concat doc-string "\n\nRead input, then "
609 (and (symbolp function) (concat "call `" (symbol-name function) "'\nto "))
612 Input-candidate completion and cycling are available. While cycling,
613 these keys with prefix `C-' are active:
615 \\<minibuffer-local-completion-map>\
616 `C-mouse-2', `C-RET' - Act on current completion candidate only
617 `C-down', `C-wheel-down' - Move to next completion candidate and act
618 `C-up', `C-wheel-up' - Move to previous completion candidate and act
619 `C-next' - Move to next apropos-completion candidate and act
620 `C-prior' - Move to previous apropos-completion candidate and act
621 `C-end' - Move to next prefix-completion candidate and act
622 `C-home' - Move to previous prefix-completion candidate and act
623 `\\[icicle-all-candidates-action]' - Act on *all* candidates, successively (careful!)
625 When candidate action and cycling are combined (e.g. `C-next'), user
626 option `icicle-act-before-cycle-flag' determines which occurs first.
628 With prefix `C-M-' instead of `C-', the same keys (`C-M-mouse-2',
629 `C-M-RET', `C-M-down', and so on) provide help about candidates.
631 Use `mouse-2', `RET', or `S-RET' to finally choose a candidate, or
634 This is an Icicles command - see command `icicle-mode'.")
635 ,(and (not not-interactive-p) '(interactive))
636 (let* ((icicle-orig-buff (current-buffer))
637 (icicle-orig-window (selected-window))
638 ,@(macroexpand bindings)
639 (icicle-candidate-action-fn
641 (let ((minibuffer-completion-table minibuffer-completion-table)
642 (minibuffer-completion-predicate minibuffer-completion-predicate)
643 (minibuffer-completion-confirm minibuffer-completion-confirm)
644 (minibuffer-completing-file-name minibuffer-completing-file-name)
645 (minibuffer-completing-symbol (and (boundp 'minibuffer-completing-symbol)
646 minibuffer-completing-symbol))
647 (minibuffer-exit-hook minibuffer-exit-hook)
648 (minibuffer-help-form minibuffer-help-form)
649 (minibuffer-history-variable minibuffer-history-variable)
650 (minibuffer-history-case-insensitive-variables
651 minibuffer-history-case-insensitive-variables)
652 (minibuffer-history-sexp-flag minibuffer-history-sexp-flag)
653 (minibuffer-message-timeout (and (boundp 'minibuffer-message-timeout)
654 minibuffer-message-timeout))
655 (minibuffer-prompt-properties (and (boundp 'minibuffer-prompt-properties)
656 minibuffer-prompt-properties))
657 (minibuffer-setup-hook minibuffer-setup-hook)
658 (minibuffer-text-before-history minibuffer-text-before-history))
659 (setq candidate (expand-file-name
660 candidate (icicle-file-name-directory icicle-last-input)))
661 (icicle-condition-case-no-debug in-action-fn
662 ;; Treat 3 cases, because previous use of `icicle-candidate-action-fn'
663 ;; might have deleted the file or the window.
664 (cond ((and (buffer-live-p icicle-orig-buff) (window-live-p icicle-orig-window))
665 (with-current-buffer icicle-orig-buff
666 (save-selected-window (select-window icicle-orig-window)
667 (funcall #',function candidate))))
668 ((window-live-p icicle-orig-window)
669 (save-selected-window (select-window icicle-orig-window)
670 (funcall #',function candidate)))
672 (funcall #',function candidate)))
673 (error (unless (string= "Cannot switch buffers in minibuffer window"
674 (error-message-string in-action-fn))
675 (error "%s" (error-message-string in-action-fn)))
676 (when (window-live-p icicle-orig-window)
677 (select-window icicle-orig-window)
678 (select-frame-set-input-focus (selected-frame)))
679 (funcall #',function candidate)))
680 (select-window (minibuffer-window))
681 (select-frame-set-input-focus (selected-frame))
682 nil)))) ; Return nil for success.
684 (icicle-condition-case-no-debug act-on-choice
686 (if (< emacs-major-version 21) ; No predicate arg for Emacs 20.
687 (read-file-name ,prompt ,dir ,default-filename ,require-match ,initial-input)
688 (read-file-name ,prompt ,dir ,default-filename ,require-match
689 ,initial-input ,predicate))))
690 ;; Reset after reading input, so that commands can tell whether input has been read.
691 (setq icicle-candidate-action-fn nil) ; Reset after completion.
692 (funcall #',function file-choice))
693 (quit (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp)
694 (error (icicle-try-switch-buffer icicle-orig-buff) ,undo-sexp
695 (error "%s" (error-message-string act-on-choice))))
699 (defmacro icicle-define-sort-command (sort-order comparison-fn doc-string)
700 "Define a command to sort completions by SORT-ORDER.
701 SORT-ORDER is a short string (or symbol) describing the sort order.
702 It is used after the phrase \"Sorting is now \". Examples: \"by date\",
703 \"alphabetically\", \"directories first\", and \"previously used first\".
705 The new command is named by replacing any spaces in SORT-ORDER with
706 hyphens (`-') and then adding the prefix `icicle-sort-'.
708 COMPARISON-FN is a function that compares two strings, returning
709 non-nil if and only if the first string sorts before the second.
711 DOC-STRING is the doc string of the new command."
712 (unless (stringp sort-order) (setq sort-order (symbol-name sort-order)))
713 (let ((command (intern (concat "icicle-sort-"
714 (replace-regexp-in-string "\\s-+" "-" sort-order)))))
716 (setq icicle-sort-orders-alist (icicle-assoc-delete-all
718 icicle-sort-orders-alist))
719 (push (cons ,sort-order ',comparison-fn) icicle-sort-orders-alist)
723 (setq icicle-sort-comparer #',comparison-fn)
724 (message "Sorting is now %s%s" ,sort-order (if icicle-reverse-sort-p ", REVERSED" ""))
725 (icicle-complete-again-update)))))
729 ;;; Functions --------------------------------------------------------
731 (defun icicle-assoc-delete-all (key alist)
732 "Delete from ALIST all elements whose car is `equal' to KEY.
733 Return the modified alist.
734 Elements of ALIST that are not conses are ignored."
735 (while (and (consp (car alist)) (equal (car (car alist)) key))
736 (setq alist (cdr alist)))
737 (let ((tail alist) tail-cdr)
738 (while (setq tail-cdr (cdr tail))
739 (if (and (consp (car tail-cdr)) (equal (car (car tail-cdr)) key))
740 (setcdr tail (cdr tail-cdr))
741 (setq tail tail-cdr))))
744 (defun icicle-try-switch-buffer (buffer)
745 "Try to switch to BUFFER, first in same window, then in other window."
746 (when (and (buffer-live-p buffer) (not icicle-inhibit-try-switch-buffer))
747 (condition-case err-switch-to
748 (switch-to-buffer buffer)
749 (error (and (string= "Cannot switch buffers in minibuffer window"
750 (error-message-string err-switch-to))
751 ;; Try another window. Don't bother if the buffer to switch to is a minibuffer.
752 (condition-case err-switch-other
753 (unless (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
754 (switch-to-buffer-other-window buffer))
755 (error (error-message-string err-switch-other)))))))) ; Return error message string.
757 (unless (fboundp 'select-frame-set-input-focus) ; Defined in Emacs 22.
758 (defun select-frame-set-input-focus (frame)
759 "Select FRAME, raise it, and set input focus, if possible."
762 ;; Ensure, if possible, that frame gets input focus.
763 (cond ((eq window-system 'x) (x-focus-frame frame))
764 ((eq window-system 'w32) (w32-focus-frame frame)))
765 (cond (focus-follows-mouse (set-mouse-position (selected-frame) (1- (frame-width)) 0)))))
768 ;;; Miscellaneous -----------------------------------------
770 ;; Make Emacs-Lisp mode fontify definitions of Icicles commands.
771 (font-lock-add-keywords
773 `((,(concat "(" (regexp-opt '("icicle-define-add-to-alist-command" "icicle-define-command"
774 "icicle-define-file-command" "icicle-define-sort-command")
776 ;; $$ "\\s-+\\(\\sw\\(\\sw\\|\\s_\\)+\\)")
777 "\\>[ \t'\(]*\\(\\sw+\\)?")
778 (1 font-lock-keyword-face)
779 ;; Index (2 or 3) depends on whether or not shy groups are supported.
780 ,(list (if (string-match "\\(?:\\)" "") 2 3) 'font-lock-function-name-face nil t))
781 ("(\\(icicle-condition-case-no-debug\\)\\>" 1 font-lock-keyword-face)))
783 ;; Make Icicles macros indent better.
784 (put 'icicle-define-command 'common-lisp-indent-function '(4 &body))
785 (put 'icicle-define-file-command 'common-lisp-indent-function '(4 &body))
786 (put 'icicle-define-sort-command 'common-lisp-indent-function '(4 4 &body))
787 (put 'icicle-define-add-to-alist-command 'common-lisp-indent-function '(4 &body))
788 (put 'icicle-with-selected-window 'common-lisp-indent-function '(4 &body))
789 (put 'icicle-condition-case-no-debug 'common-lisp-indent-function '(4 4 &body))
791 ;; You might also want to use the following or something similar.
792 ;; (defun lisp-indentation-hack ()
793 ;; "Better Lisp indenting. Use in Lisp mode hooks
794 ;; such as `lisp-mode-hook', `emacs-lisp-mode-hook', and
795 ;; `lisp-interaction-mode-hook'."
796 ;; (load "cl-indent" nil t)
797 ;; (set (make-local-variable 'lisp-indent-function) 'common-lisp-indent-function)
798 ;; (setq lisp-indent-maximum-backtracking 10)
799 ;; (put 'define-derived-mode 'common-lisp-indent-function '(4 4 4 2 &body))
800 ;; (put 'if 'common-lisp-indent-function '(nil nil &body)))
802 ;; (add-hook 'emacs-lisp-mode-hook 'lisp-indentation-hack)
803 ;; (add-hook 'lisp-mode-hook 'lisp-indentation-hack)
804 ;; (add-hook 'lisp-interaction-mode-hook 'lisp-indentation-hack)
806 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
808 (provide 'icicles-mac)
810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
811 ;;; icicles-mac.el ends here