anything.el (anything-scroll-other-window-base, anything-scroll-other-window, anythin...
[anything-config.git] / anything.el
blobf5f9d4f0a2ca92095bd69d3aab4ac487a2367f68
1 ;;;; anything.el --- open anything / QuickSilver-like candidate-selection framework
3 ;; Copyright (C) 2007 Tamas Patrovics
4 ;; 2008, 2009, 2010 rubikitch <rubikitch@ruby-lang.org>
6 ;; Author: Tamas Patrovics
7 ;; Maintainer: rubikitch <rubikitch@ruby-lang.org>
8 ;; Keywords: files, frames, help, matching, outlines, processes, tools, convenience, anything
9 ;; URL: http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
10 ;; Site: http://www.emacswiki.org/cgi-bin/emacs/Anything
11 (defvar anything-version nil)
12 (setq anything-version "1.285")
14 ;; This file is free software; you can redistribute it and/or modify
15 ;; it under the terms of the GNU General Public License as published by
16 ;; the Free Software Foundation; either version 2, or (at your option)
17 ;; any later version.
19 ;; This file is distributed in the hope that it will be useful,
20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 ;; GNU General Public License for more details.
25 ;; You should have received a copy of the GNU General Public License
26 ;; along with GNU Emacs; see the file COPYING. If not, write to the
27 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
28 ;; Boston, MA 02110-1301, USA.
30 ;;; Commentary:
33 ;; Start with M-x anything, narrow the list by typing some pattern,
34 ;; select with up/down/pgup/pgdown/C-p/C-n/C-v/M-v, choose with enter,
35 ;; left/right moves between sources. With TAB actions can be selected
36 ;; if the selected candidate has more than one possible action.
38 ;; Note that anything.el provides only the framework and some example
39 ;; configurations for demonstration purposes. See anything-config.el
40 ;; for practical, polished, easy to use configurations which can be
41 ;; used to assemble a custom personalized configuration. And many
42 ;; other configurations are in the EmacsWiki.
43 ;;
44 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-config.el
45 ;; http://www.emacswiki.org/cgi-bin/emacs/AnythingSources
47 ;; Maintainer's configuration is in the EmacsWiki. It would tell you
48 ;; many tips to write smart sources!
50 ;; http://www.emacswiki.org/cgi-bin/emacs/RubikitchAnythingConfiguration
52 ;; Here is Japanese translation of `anything-sources' attributes. Thanks.
53 ;; http://d.hatena.ne.jp/sirocco634/20091012/1255336649
55 ;;; Bug Report:
57 ;; If you have problems, send a bug report via C-c C-x C-b in anything session (best)
58 ;; or M-x anything-send-bug-report outside anything session.
59 ;; I implemented bug report feature because I want to know your current state.
60 ;; It helps me to solve problems easily.
61 ;; The step is:
62 ;; 0) Setup mail in Emacs, the easiest way is:
63 ;; (setq user-mail-address "your@mail.address")
64 ;; (setq user-full-name "Your Full Name")
65 ;; (setq smtpmail-smtp-server "your.smtp.server.jp")
66 ;; (setq mail-user-agent 'message-user-agent)
67 ;; (setq message-send-mail-function 'message-smtpmail-send-it)
68 ;; 1) Be sure to use the LATEST version of anything.el.
69 ;; 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t)
70 ;; 3) Use Lisp version instead of compiled one: (load "anything.el")
71 ;; 4) Do it!
72 ;; 5) If you got an error, please do not close *Backtrace* buffer.
73 ;; 6) Type C-c C-x C-b (anything session, best!)
74 ;; or M-x anything-send-bug-report (outside)
75 ;; then M-x insert-buffer *Backtrace* (if you got error)
76 ;; 7) Describe the bug using a precise recipe.
77 ;; 8) Type C-c C-c to send.
78 ;; # If you are a Japanese, please write in Japanese:-)
81 ;;; Commands:
83 ;; Below are complete command list:
85 ;; `anything'
86 ;; Select anything. In Lisp program, some optional arguments can be used.
87 ;; `anything-resume'
88 ;; Resurrect previously invoked `anything'.
89 ;; `anything-at-point'
90 ;; Same as `anything' except when C-u is pressed, the initial input is the symbol at point.
91 ;; `anything-force-update'
92 ;; Recalculate and update candidates.
93 ;; `anything-select-action'
94 ;; Select an action for the currently selected candidate.
95 ;; `anything-previous-line'
96 ;; Move selection to the previous line.
97 ;; `anything-next-line'
98 ;; Move selection to the next line.
99 ;; `anything-previous-page'
100 ;; Move selection back with a pageful.
101 ;; `anything-next-page'
102 ;; Move selection forward with a pageful.
103 ;; `anything-beginning-of-buffer'
104 ;; Move selection at the top.
105 ;; `anything-end-of-buffer'
106 ;; Move selection at the bottom.
107 ;; `anything-previous-source'
108 ;; Move selection to the previous source.
109 ;; `anything-next-source'
110 ;; Move selection to the next source.
111 ;; `anything-select-with-prefix-shortcut'
112 ;; Invoke default action with prefix shortcut.
113 ;; `anything-select-with-digit-shortcut'
114 ;; Invoke default action with digit/alphabet shortcut.
115 ;; `anything-exit-minibuffer'
116 ;; Select the current candidate by exiting the minibuffer.
117 ;; `anything-help'
118 ;; Help of `anything'.
119 ;; `anything-debug-output'
120 ;; Show all anything-related variables at this time.
121 ;; `anything-delete-current-selection'
122 ;; Delete the currently selected item.
123 ;; `anything-delete-minibuffer-contents'
124 ;; Same as `delete-minibuffer-contents' but this is a command.
125 ;; `anything-toggle-resplit-window'
126 ;; Toggle resplit anything window, vertically or horizontally.
127 ;; `anything-select-2nd-action'
128 ;; Select the 2nd action for the currently selected candidate.
129 ;; `anything-select-3rd-action'
130 ;; Select the 3rd action for the currently selected candidate.
131 ;; `anything-select-4th-action'
132 ;; Select the 4th action for the currently selected candidate.
133 ;; `anything-select-2nd-action-or-end-of-line'
134 ;; Select the 2nd action for the currently selected candidate if the point is at the end of minibuffer.
135 ;; `anything-execute-persistent-action'
136 ;; If a candidate is selected then perform the associated action without quitting anything.
137 ;; `anything-scroll-other-window'
138 ;; Scroll other window (not *Anything* window) upward.
139 ;; `anything-scroll-other-window-down'
140 ;; Scroll other window (not *Anything* window) downward.
141 ;; `anything-display-all-visible-marks'
142 ;; Show all `anything' visible marks strings.
143 ;; `anything-quit-and-find-file'
144 ;; Drop into `find-file' from `anything' like `iswitchb-find-file'.
145 ;; `anything-yank-selection'
146 ;; Set minibuffer contents to current selection.
147 ;; `anything-kill-selection-and-quit'
148 ;; Store current selection to kill ring.
149 ;; `anything-follow-mode'
150 ;; If this mode is on, persistent action is executed everytime the cursor is moved.
151 ;; `anything-migrate-sources'
152 ;; Help to migrate to new `anything' way.
153 ;; `anything-isearch'
154 ;; Start incremental search within results. (UNMAINTAINED)
155 ;; `anything-isearch-printing-char'
156 ;; Add printing char to the pattern.
157 ;; `anything-isearch-again'
158 ;; Search again for the current pattern
159 ;; `anything-isearch-delete'
160 ;; Undo last event.
161 ;; `anything-isearch-default-action'
162 ;; Execute the default action for the selected candidate.
163 ;; `anything-isearch-select-action'
164 ;; Choose an action for the selected candidate.
165 ;; `anything-isearch-cancel'
166 ;; Cancel Anything isearch.
167 ;; `anything-iswitchb-setup'
168 ;; Integrate anything completion into iswitchb (UNMAINTAINED).
169 ;; `anything-iswitchb-cancel-anything'
170 ;; Cancel anything completion and return to standard iswitchb.
171 ;; `anything-describe-anything-attribute'
172 ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
173 ;; `anything-send-bug-report'
174 ;; Send a bug report of anything.el.
175 ;; `anything-send-bug-report-from-anything'
176 ;; Send a bug report of anything.el in anything session.
178 ;;; Customizable Options:
180 ;; Below are customizable option list:
183 ;; You can extend `anything' by writing plug-ins. As soon as
184 ;; `anything' is invoked, `anything-sources' is compiled into basic
185 ;; attributes, then compiled one is used during invocation.
187 ;; The oldest built-in plug-in is `type' attribute: appends
188 ;; appropriate element of `anything-type-attributes'. Second built-in
189 ;; plug-in is `candidates-in-buffer': selecting a line from candidates
190 ;; buffer.
192 ;; To write a plug-in:
193 ;; 1. Define a compiler: anything-compile-source--*
194 ;; 2. Add compier function to `anything-compile-source-functions'.
195 ;; 3. (optional) Write helper functions.
197 ;; Anything plug-ins are found in the EmacsWiki.
199 ;; http://www.emacswiki.org/cgi-bin/emacs/AnythingPlugins
201 ;; Tested on Emacs 22/23.
204 ;; Thanks to Vagn Johansen for ideas.
205 ;; Thanks to Stefan Kamphausen for fixes and XEmacs support.
206 ;; Thanks to Tassilo Horn for fixes.
207 ;; Thanks to Drew Adams for various fixes (frame, isearch, customization, etc.)
208 ;; Thanks to IMAKADO for candidates-in-buffer idea.
209 ;; Thanks to Tomohiro MATSUYAMA for multiline patch.
212 ;;; (@* "Index")
214 ;; If you have library `linkd.el', load
215 ;; `linkd.el' and turn on `linkd-mode' now. It lets you easily
216 ;; navigate around the sections Linkd mode will
217 ;; highlight this Index. You can get `linkd.el' here:
218 ;; http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el
222 ;;; (@* "INCOMPATIBLE CHANGES")
224 ;; v1.277
226 ;; Default setting of `anything-save-configuration-functions' is changed.
227 ;; Anything saves/restores window configuration instead of frame configuration now.
228 ;; The default is changed because flickering is occurred in some environment.
230 ;; If you want to save and restore frame configuration, set this variable to
231 ;; '(set-frame-configuration . current-frame-configuration)
233 ;; v1.276
235 ;; Fitting frame is disabled by default, because some flickering occurred
236 ;; in some environment. To enable fitting, set both
237 ;; `anything-inhibit-fit-frame-flag' and `fit-frame-inhibit-fitting' to
238 ;; nil.
240 ;; v1.114
242 ;; `anything-attr' returns nil when the source attribute is defined
243 ;; but the value of attribute is nil, eg. (volatile) cell. Use
244 ;; `anything-attr-defined' when testing whether the attribute is
245 ;; defined.
247 ;;; (@* "Tips")
250 ;; `anything' accepts keyword arguments. See docstring.
251 ;; [EVAL IT] (describe-function 'anything)
254 ;; `anything-enable-shortcuts' enables us to select candidate easily.
255 ;; If 'prefix then they can be selected using <prefix-key> <alnum>.
256 ;; The prefix key is `anything-select-with-prefix-shortcut'.
257 ;; If the <prefix-key> is a letter, pressing twice inputs the letter itself.
258 ;; e.g.
259 ;; (setq anything-enable-shortcuts 'prefix)
260 ;; (define-key anything-map \"@\" 'anything-select-with-prefix-shortcut)
263 ;; You can edit current selection using `anything-edit-current-selection'.
264 ;; It is useful after persistent-action.
267 ;; For `anything' users, setting `anything-sources' directly and
268 ;; invoke M-x anything is obsolete way for now. Try M-x
269 ;; `anything-migrate-sources'!
272 ;; If you want to create anything sources, yasnippet would help you.
273 ;; http://yasnippet.googlecode.com/
275 ;; Then get the snippet from
276 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything-source.yasnippet
278 ;; Put it in ~/.emacs.d/plugins/yasnippet/snippets/text-mode/emacs-lisp-mode/
282 ;; `anything-interpret-value' is useful function to interpret value
283 ;; like `candidates' attribute.
285 ;; (anything-interpret-value "literal") ; => "literal"
286 ;; (anything-interpret-value (lambda () "lambda")) ; => "lambda"
287 ;; (let ((source '((name . "lambda with source name"))))
288 ;; (anything-interpret-value
289 ;; (lambda () anything-source-name)
290 ;; source)) ; => "lambda with source name"
291 ;; (flet ((f () "function symbol"))
292 ;; (anything-interpret-value 'f)) ; => "function symbol"
293 ;; (let ((v "variable symbol"))
294 ;; (anything-interpret-value 'v)) ; => "variable symbol"
295 ;; (anything-interpret-value 'unbounded-1) ; error
298 ;; Now symbols are acceptable as candidates. So you do not have to use
299 ;; `symbol-name' function. The source is much simpler. For example,
300 ;; `apropos-internal' returns a list of symbols.
302 ;; (anything
303 ;; '(((name . "Commands")
304 ;; (candidates . (lambda () (apropos-internal anything-pattern 'commandp)))
305 ;; (volatile)
306 ;; (action . describe-function))))
309 ;; To mark a candidate, press C-SPC as normal Emacs marking. To go to
310 ;; marked candidate, press M-[ or M-].
313 ;; `anything-map' is now Emacs-standard key bindings by default. If
314 ;; you are using `iswitchb', execute `anything-iswitchb-setup'. Then
315 ;; some key bindings are adjusted to `iswitchb'. Note that
316 ;; anything-iswitchb is not maintained.
319 ;; There are many `anything' applications, using `anything' for
320 ;; selecting candidate. In this case, if there is one candidate or no
321 ;; candidate, popping up *anything* buffer is irritating. If one
322 ;; candidate, you want to select it at once. If no candidate, you want
323 ;; to quit `anything'. Set `anything-execute-action-at-once-if-one'
324 ;; and `anything-quit-if-no-candidate' to non-nil to remedy it. Note
325 ;; that setting these variables GLOBALLY is bad idea because of
326 ;; delayed sources. These are meant to be let-binded.
327 ;; See anything-etags.el for example.
329 ;; [EVAL IT] (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/anything-etags.el")
331 ;; ex.
332 ;; (let ((anything-execute-action-at-once-if-one t)
333 ;; (anything-quit-if-no-candidate (lambda () (message "No candidate"))))
334 ;; (anything temporary-sources input))
337 ;; `set-frame-configuration' arises flickering. If you hate
338 ;; flickering, eval:
339 ;; (setq anything-save-configuration-functions
340 ;; '(set-window-configuration . current-window-configuration))
341 ;; at the cost of restoring frame configuration (only window configuration).
344 ;; `anything-delete-current-selection' deletes the current line.
345 ;; It is useful when deleting a candidate in persistent action.
346 ;; eg. `kill-buffer'.
348 ;; [EVAL IT] (describe-function 'anything-delete-current-selection)
351 ;; `anything-attr' gets the attribute. `anything-attrset' sets the
352 ;; attribute. `anything-attr-defined' tests whether the attribute is
353 ;; defined. They handles source-local variables.
355 ;; [EVAL IT] (describe-function 'anything-attr)
356 ;; [EVAL IT] (describe-function 'anything-attrset)
357 ;; [EVAL IT] (describe-function 'anything-attr-defined)
360 ;; `anything-sources' accepts many attributes to make your life easier.
361 ;; Now `anything-sources' accepts a list of symbols.
363 ;; [EVAL IT] (describe-variable 'anything-sources)
366 ;; `anything' has optional arguments. Now you do not have to let-bind
367 ;; `anything-sources'.
369 ;; [EVAL IT] (describe-function 'anything)
372 ;; `anything-resume' resumes last `anything' session. Now you do not
373 ;; have to retype pattern.
375 ;; [EVAL IT] (describe-function 'anything-resume)
378 ;; `anything-execute-persistent-action' executes action without
379 ;; quitting `anything'. When popping up a buffer in other window by
380 ;; persistent action, you can scroll with `anything-scroll-other-window' and
381 ;; `anything-scroll-other-window-down'. See also `anything-sources' docstring.
383 ;; [EVAL IT] (describe-function 'anything-execute-persistent-action)
384 ;; [EVAL IT] (describe-variable 'anything-sources)
387 ;; `anything-select-2nd-action', `anything-select-3rd-action' and
388 ;; `anything-select-4th-action' select other than default action
389 ;; without pressing Tab.
392 ;; Using `anything-candidate-buffer' and the candidates-in-buffer
393 ;; attribute is much faster than traditional "candidates and match"
394 ;; way. And `anything-current-buffer-is-modified' avoids to
395 ;; recalculate candidates for unmodified buffer. See docstring of
396 ;; them.
398 ;; [EVAL IT] (describe-function 'anything-candidate-buffer)
399 ;; [EVAL IT] (describe-function 'anything-candidates-in-buffer)
400 ;; [EVAL IT] (describe-function 'anything-current-buffer-is-modified)
403 ;; `anything-current-buffer' and `anything-buffer-file-name' stores
404 ;; `(current-buffer)' and `buffer-file-name' in the buffer `anything'
405 ;; is invoked. Use them freely.
407 ;; [EVAL IT] (describe-variable 'anything-current-buffer)
408 ;; [EVAL IT] (describe-variable 'anything-buffer-file-name)
411 ;; `anything-completing-read' and `anything-read-file-name' are
412 ;; experimental implementation. If you are curious, type M-x
413 ;; anything-read-string-mode. It is a minor mode and toggles on/off.
416 ;; Use `anything-test-candidates' to test your handmade anything
417 ;; sources. It simulates contents of *anything* buffer with pseudo
418 ;; `anything-sources' and `anything-pattern', without side-effect. So
419 ;; you can unit-test your anything sources! Let's TDD!
421 ;; [EVAL IT] (describe-function 'anything-test-candidates)
423 ;; There are many unit-testing framework in Emacs Lisp. See the EmacsWiki.
424 ;; http://www.emacswiki.org/cgi-bin/emacs/UnitTesting
426 ;; There is an unit-test by Emacs Lisp Expectations at the tail of this file.
427 ;; http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el
428 ;; http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el
431 ;; If you want to create anything sources, see anything-config.el.
432 ;; It is huge collection of sources. You can learn from examples.
435 ;; (@* "TODO")
437 ;; - process status indication
439 ;; - async sources doesn't honor digit-shortcut-count
441 ;; - anything-candidate-number-limit can't be nil everywhere
443 ;; (@* "HISTORY")
445 ;; Change log of this file is found at
446 ;; http://repo.or.cz/w/anything-config.git/history/master:/anything.el
448 ;; Change log of this project is found at
449 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
451 (require 'cl)
452 ;; (require 'anything-match-plugin nil t)
454 ;; (@* "User Configuration")
456 ;; This is only an example. Customize it to your own taste!
457 (defvar anything-sources `(((name . "Buffers")
458 (candidates
459 . (lambda ()
460 (remove-if (lambda (name)
461 (or (equal name anything-buffer)
462 (eq ?\ (aref name 0))))
463 (mapcar 'buffer-name (buffer-list)))))
464 (type . buffer))
466 ((name . "File Name History")
467 (candidates . file-name-history)
468 (match (lambda (candidate)
469 ;; list basename matches first
470 (string-match
471 anything-pattern
472 (file-name-nondirectory candidate)))
474 (lambda (candidate)
475 ;; and then directory part matches
476 (let ((dir (file-name-directory candidate)))
477 (if dir
478 (string-match anything-pattern dir)))))
479 (type . file))
481 ((name . "Files from Current Directory")
482 (init . (lambda ()
483 (setq anything-default-directory
484 default-directory)))
485 (candidates . (lambda ()
486 (directory-files
487 anything-default-directory)))
488 (type . file))
490 ((name . "Complex Command History")
491 (candidates . (lambda ()
492 (mapcar 'prin1-to-string
493 command-history)))
494 (action . (("Repeat Complex Command" .
495 (lambda (c)
496 (eval (read c))))))
497 (delayed)))
498 "The source of candidates for anything.
499 It accepts symbols:
500 (setq anything-sources (list anything-c-foo anything-c-bar))
501 can be written as
502 (setq anything-sources '(anything-c-foo anything-c-bar))
503 The latter is recommended because if you change anything-c-* variable,
504 you do not have to update `anything-sources'.
506 You are STRONGLY recommended to define a command which calls
507 `anything' or `anything-other-buffer' with argument rather than
508 to set `anything-sources' externally.
510 If you want to change `anything-sources' during `anything' invocation,
511 use `anything-set-sources', never use `setq'.
513 Attributes:
518 ;; This value is only provided as an example. Customize it to your own
519 ;; taste!
520 (defvar anything-type-attributes
521 '((file (action . (("Find File" . find-file)
522 ("Delete File" . (lambda (file)
523 (if (y-or-n-p (format "Really delete file %s? "
524 file))
525 (delete-file file)))))))
526 (buffer (action . (("Switch to Buffer" . switch-to-buffer)
527 ("Pop to Buffer" . pop-to-buffer)
528 ("Display Buffer" . display-buffer)
529 ("Kill Buffer" . kill-buffer)))))
530 "It's a list of (TYPE ATTRIBUTES ...). ATTRIBUTES are the same
531 as attributes for `anything-sources'. TYPE connects the value
532 to the appropriate sources in `anything-sources'.
534 This allows specifying common attributes for several
535 sources. For example, sources which provide files can specify
536 common attributes with a `file' type.")
539 (defvaralias 'anything-enable-digit-shortcuts 'anything-enable-shortcuts
540 "Alphabet shortcuts are usable now. Then `anything-enable-digit-shortcuts' should be renamed.
541 `anything-enable-digit-shortcuts' is retained for compatibility.")
542 (defvar anything-enable-shortcuts nil
543 "*Whether to use digit/alphabet shortcut to select the first nine matches.
544 If t then they can be selected using Ctrl+<number>.
546 If 'prefix then they can be selected using <prefix-key> <alnum>.
547 The prefix key is `anything-select-with-prefix-shortcut'.
548 If the <prefix-key> is a letter, pressing twice inputs the letter itself.
549 e.g.
550 (setq anything-enable-shortcuts 'prefix)
551 (define-key anything-map \"@\" 'anything-select-with-prefix-shortcut)
553 If 'alphabet then they can be selected using Shift+<alphabet> (deprecated).
554 It is not recommended because you cannot input capital letters in pattern.
556 Keys (digit/alphabet) are listed in `anything-shortcut-keys-alist'.")
558 (defvar anything-shortcut-keys-alist
559 '((alphabet . "asdfghjklzxcvbnmqwertyuiop")
560 (prefix . "asdfghjklzxcvbnmqwertyuiop1234567890")
561 (t . "123456789")))
563 (defvar anything-display-source-at-screen-top t
564 "*If t, `anything-next-source' and `anything-previous-source'
565 display candidates at the top of screen.")
567 (defvar anything-candidate-number-limit 50
568 "*Do not show more candidates than this limit from individual
569 sources. It is usually pointless to show hundreds of matches
570 when the pattern is empty, because it is much simpler to type a
571 few characters to narrow down the list of potential candidates.
573 Set it to nil if you don't want this limit.")
576 (defvar anything-idle-delay 0.5
577 "*The user has to be idle for this many seconds, before
578 candidates from delayed sources are collected. This is useful
579 for sources involving heavy operations (like launching external
580 programs), so that candidates from the source are not retrieved
581 unnecessarily if the user keeps typing.
583 It also can be used to declutter the results anything displays,
584 so that results from certain sources are not shown with every
585 character typed, only if the user hesitates a bit.")
588 (defvar anything-input-idle-delay 0.1
589 "The user has to be idle for this many seconds, before ALL candidates are collected.
590 Unlink `anything-input-idle', it is also effective for non-delayed sources.
591 If nil, candidates are collected immediately. ")
594 (defvar anything-samewindow nil
595 "If t then Anything doesn't pop up a new window, it uses the
596 current window to show the candidates.")
599 (defvar anything-source-filter nil
600 "A list of source names to be displayed. Other sources won't
601 appear in the search results. If nil then there is no filtering.
602 See also `anything-set-source-filter'.")
605 (defvar anything-map
606 (let ((map (copy-keymap minibuffer-local-map)))
607 (define-key map (kbd "<down>") 'anything-next-line)
608 (define-key map (kbd "<up>") 'anything-previous-line)
609 (define-key map (kbd "C-n") 'anything-next-line)
610 (define-key map (kbd "C-p") 'anything-previous-line)
611 (define-key map (kbd "<prior>") 'anything-previous-page)
612 (define-key map (kbd "<next>") 'anything-next-page)
613 (define-key map (kbd "M-v") 'anything-previous-page)
614 (define-key map (kbd "C-v") 'anything-next-page)
615 (define-key map (kbd "M-<") 'anything-beginning-of-buffer)
616 (define-key map (kbd "M->") 'anything-end-of-buffer)
617 (define-key map (kbd "<right>") 'anything-next-source)
618 (define-key map (kbd "<left>") 'anything-previous-source)
619 (define-key map (kbd "<RET>") 'anything-exit-minibuffer)
620 (define-key map (kbd "C-1") 'anything-select-with-digit-shortcut)
621 (define-key map (kbd "C-2") 'anything-select-with-digit-shortcut)
622 (define-key map (kbd "C-3") 'anything-select-with-digit-shortcut)
623 (define-key map (kbd "C-4") 'anything-select-with-digit-shortcut)
624 (define-key map (kbd "C-5") 'anything-select-with-digit-shortcut)
625 (define-key map (kbd "C-6") 'anything-select-with-digit-shortcut)
626 (define-key map (kbd "C-7") 'anything-select-with-digit-shortcut)
627 (define-key map (kbd "C-8") 'anything-select-with-digit-shortcut)
628 (define-key map (kbd "C-9") 'anything-select-with-digit-shortcut)
629 (loop for c from ?A to ?Z do
630 (define-key map (make-string 1 c) 'anything-select-with-digit-shortcut))
631 (define-key map (kbd "C-i") 'anything-select-action)
632 (define-key map (kbd "C-z") 'anything-execute-persistent-action)
633 (define-key map (kbd "C-e") 'anything-select-2nd-action-or-end-of-line)
634 (define-key map (kbd "C-j") 'anything-select-3rd-action)
635 (define-key map (kbd "C-o") 'anything-next-source)
636 (define-key map (kbd "C-M-v") 'anything-scroll-other-window)
637 (define-key map (kbd "M-<next>") 'anything-scroll-other-window)
638 (define-key map (kbd "C-M-y") 'anything-scroll-other-window-down)
639 (define-key map (kbd "C-M-S-v") 'anything-scroll-other-window-down)
640 (define-key map (kbd "M-<prior>") 'anything-scroll-other-window-down)
641 (define-key map (kbd "C-SPC") 'anything-toggle-visible-mark)
642 (define-key map (kbd "M-[") 'anything-prev-visible-mark)
643 (define-key map (kbd "M-]") 'anything-next-visible-mark)
644 (define-key map (kbd "C-k") 'anything-delete-minibuffer-contents)
646 (define-key map (kbd "C-s") 'anything-isearch)
647 (define-key map (kbd "C-r") 'undefined)
648 (define-key map (kbd "C-t") 'anything-toggle-resplit-window)
649 (define-key map (kbd "C-x C-f") 'anything-quit-and-find-file)
651 (define-key map (kbd "C-c C-d") 'anything-delete-current-selection)
652 (define-key map (kbd "C-c C-y") 'anything-yank-selection)
653 (define-key map (kbd "C-c C-k") 'anything-kill-selection-and-quit)
654 (define-key map (kbd "C-c C-f") 'anything-follow-mode)
655 (define-key map (kbd "C-c C-u") 'anything-force-update)
657 ;; Debugging command
658 (define-key map "\C-c\C-x\C-d" 'anything-debug-output)
659 (define-key map "\C-c\C-x\C-m" 'anything-display-all-visible-marks)
660 (define-key map "\C-c\C-x\C-b" 'anything-send-bug-report-from-anything)
661 ;; Use `describe-mode' key in `global-map'
662 (dolist (k (where-is-internal 'describe-mode global-map))
663 (define-key map k 'anything-help))
664 ;; the defalias is needed because commands are bound by name when
665 ;; using iswitchb, so only commands having the prefix anything-
666 ;; get rebound
667 (defalias 'anything-previous-history-element 'previous-history-element)
668 (defalias 'anything-next-history-element 'next-history-element)
669 (define-key map (kbd "M-p") 'anything-previous-history-element)
670 (define-key map (kbd "M-n") 'anything-next-history-element)
671 map)
672 "Keymap for anything.
674 If you execute `anything-iswitchb-setup', some keys are modified.
675 See `anything-iswitchb-setup-keys'.")
677 (defvar anything-isearch-map
678 (let ((map (make-sparse-keymap)))
679 (set-keymap-parent map (current-global-map))
680 (define-key map (kbd "<return>") 'anything-isearch-default-action)
681 (define-key map (kbd "<RET>") 'anything-isearch-default-action)
682 (define-key map (kbd "C-i") 'anything-isearch-select-action)
683 (define-key map (kbd "C-g") 'anything-isearch-cancel)
684 (define-key map (kbd "M-s") 'anything-isearch-again)
685 (define-key map (kbd "<backspace>") 'anything-isearch-delete)
686 ;; add printing chars
687 (loop for i from 32 below 256 do
688 (define-key map (vector i) 'anything-isearch-printing-char))
689 map)
690 "Keymap for anything incremental search.")
693 (defgroup anything nil
694 "Open anything." :prefix "anything-" :group 'convenience)
696 (defface anything-header
697 '((t (:inherit header-line)))
698 "Face for header lines in the anything buffer." :group 'anything)
700 (defvar anything-header-face 'anything-header
701 "Face for header lines in the anything buffer.")
703 (defface anything-isearch-match '((t (:background "Yellow")))
704 "Face for isearch in the anything buffer." :group 'anything)
706 (defvar anything-isearch-match-face 'anything-isearch-match
707 "Face for matches during incremental search.")
709 (defvar anything-selection-face 'highlight
710 "Face for currently selected item.")
712 (defvar anything-iswitchb-idle-delay 1
713 "Show anything completions if the user is idle that many
714 seconds after typing.")
716 (defvar anything-iswitchb-dont-touch-iswithcb-keys nil
717 "If t then those commands are not bound from `anything-map'
718 under iswitchb which would override standard iswithcb keys.
720 This allows an even more seamless integration with iswitchb for
721 those who prefer using iswitchb bindings even if the anything
722 completions buffer is popped up.
724 Note that you can bind alternative keys for the same command in
725 `anything-map', so that you can use different keys for anything
726 under iswitchb. For example, I bind the character \ to
727 `anything-exit-minibuffer' which key is just above Enter on my
728 keyboard. This way I can switch buffers with Enter and choose
729 anything completions with \.")
731 ;;----------------------------------------------------------------------
733 (defvar anything-buffer "*anything*"
734 "Buffer showing completions.")
736 (defvar anything-action-buffer "*anything action*"
737 "Buffer showing actions.")
739 (defvar anything-selection-overlay nil
740 "Overlay used to highlight the currently selected item.")
742 (defvar anything-isearch-overlay nil
743 "Overlay used to highlight the current match during isearch.")
745 (defvar anything-digit-overlays nil
746 "Overlays for digit shortcuts. See `anything-enable-shortcuts'.")
748 (defvar anything-candidate-cache nil
749 "Holds the available candidate withing a single anything invocation.")
751 (defvar anything-pattern
752 "The input pattern used to update the anything buffer.")
754 (defvar anything-input
755 "The input typed in the candidates panel.")
757 (defvar anything-async-processes nil
758 "List of information about asynchronous processes managed by anything.")
760 (defvar anything-digit-shortcut-count 0
761 "Number of digit shortcuts shown in the anything buffer.")
763 (defvar anything-before-initialize-hook nil
764 "Run before anything initialization.
765 This hook is run before init functions in `anything-sources'.")
767 (defvar anything-after-initialize-hook nil
768 "Run after anything initialization.
769 Global variables are initialized and the anything buffer is created.
770 But the anything buffer has no contents. ")
772 (defvar anything-update-hook nil
773 "Run after the anything buffer was updated according the new input pattern.
774 This hook is run at the beginning of buffer.
775 The first candidate is selected after running this hook.
776 See also `anything-after-update-hook'.")
778 (defvar anything-after-update-hook nil
779 "Run after the anything buffer was updated according the new input pattern.
780 This is very similar to `anything-update-hook' but selection is not moved.
781 It is useful to select a particular object instead of the first one. ")
783 (defvar anything-cleanup-hook nil
784 "Run after anything minibuffer is closed, IOW this hook is executed BEFORE performing action. ")
786 (defvar anything-after-action-hook nil
787 "Run after executing action.")
789 (defvar anything-after-persistent-action-hook nil
790 "Run after executing persistent action.")
792 (defvar anything-restored-variables
793 '( anything-candidate-number-limit
794 anything-source-filter
795 anything-source-in-each-line-flag
796 anything-map
797 anything-sources
798 deferred-action-list)
799 "Variables which are restored after `anything' invocation.")
800 ;; `anything-saved-sources' is removed
802 (defvar anything-saved-selection nil
803 "Saved value of the currently selected object when the action
804 list is shown.")
806 ;; `anything-original-source-filter' is removed
808 (defvar anything-candidate-separator
809 "--------------------"
810 "Candidates separator of `multiline' source.")
812 (defvar anything-current-buffer nil
813 "Current buffer when `anything' is invoked.")
815 (defvar anything-buffer-file-name nil
816 "`buffer-file-name' when `anything' is invoked.")
818 (defvar anything-saved-action nil
819 "Saved value of the currently selected action by key.")
821 (defvar anything-last-sources nil
822 "OBSOLETE!! Sources of previously invoked `anything'.")
824 (defvar anything-saved-current-source nil
825 "Saved value of the original (anything-get-current-source) when the action
826 list is shown.")
828 (defvar anything-compiled-sources nil
829 "Compiled version of `anything-sources'. ")
831 (defvar anything-in-persistent-action nil
832 "Flag whether in persistent-action or not.")
834 (defvar anything-quick-update nil
835 "If non-nil, suppress displaying sources which are out of screen at first.
836 They are treated as delayed sources at this input.
837 This flag makes `anything' a bit faster with many sources.")
839 (defvar anything-last-sources-local nil
840 "Buffer local value of `anything-sources'.")
841 (defvar anything-last-buffer nil
842 "`anything-buffer' of previously `anything' session.")
844 (defvar anything-save-configuration-functions
845 '(set-window-configuration . current-window-configuration)
846 "If you want to save and restore frame configuration, set this variable to
847 '(set-frame-configuration . current-frame-configuration)
849 Older version saves/restores frame configuration, but the default is changed now,
850 because flickering is occurred in some environment.
853 (defvar anything-persistent-action-use-special-display nil
854 "If non-nil, use `special-display-function' in persistent action.")
856 (defvar anything-execute-action-at-once-if-one nil
857 "If non-nil and there is one candidate, execute the first action without selection.
858 It is useful for `anything' applications.")
860 (defvar anything-quit-if-no-candidate nil
861 "if non-nil and there is no candidate, do not display *anything* buffer and quit.
862 This variable accepts a function, which is executed if no candidate.
864 It is useful for `anything' applications.")
866 (defvar anything-scroll-amount nil
867 "Scroll amount used by `anything-scroll-other-window' and `anything-scroll-other-window-down'.
868 If you prefer scrolling line by line, set this value to 1.")
870 (defvar anything-display-function 'anything-default-display-buffer
871 "Function to display *anything* buffer.
872 It is `anything-default-display-buffer' by default, which affects `anything-samewindow'.")
874 (defvar anything-delayed-init-executed nil)
876 (defvar anything-mode-line-string "\\<anything-map>\\[anything-help]:help \\[anything-select-action]:Acts \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\\[anything-select-3rd-action]:NthAct \\[anything-send-bug-report-from-anything]:BugReport"
877 "Help string displayed in mode-line in `anything'.
878 If nil, use default `mode-line-format'.")
880 (defvar anything-help-message
881 "\\<anything-map>The keys that are defined for `anything' are:
882 \\{anything-map}"
883 "Detailed help message string for `anything'.
884 It also accepts function or variable symbol.")
886 (put 'anything 'timid-completion 'disabled)
888 (defvar anything-inhibit-fit-frame-flag t
889 "If non-nil, inhibit fitting anything frame to its buffer.
890 It is nil by default because some flickering occurred in some environment.
892 To enable fitting, set both `anything-inhibit-fit-frame-flag' and
893 `fit-frame-inhibit-fitting' to nil.")
895 (defvar anything-source-in-each-line-flag nil
896 "If non-nil, add anything-source text-property in each candidate.
897 experimental feature.")
899 (defvaralias 'anything-debug-variables 'anything-debug-forms)
900 (defvar anything-debug-forms nil
901 "Forms to show in `anything-debug-output'.
902 Otherwise all variables started with `anything-' are shown.
903 It is useful for debug.")
905 (defvar anything-debug nil
906 "If non-nil, write log message into *Anything Log* buffer.
907 If `debug-on-error' is non-nil, write log message regardless of this variable.
908 It is disabled by default because *Anything Log* grows quickly.")
910 ;; (@* "Internal Variables")
911 (defvar anything-test-candidate-list nil)
912 (defvar anything-test-mode nil)
913 (defvar anything-source-name nil)
914 (defvar anything-candidate-buffer-alist nil)
915 (defvar anything-check-minibuffer-input-timer nil)
916 (defvar anything-match-hash (make-hash-table :test 'equal))
917 (defvar anything-cib-hash (make-hash-table :test 'equal))
918 (defvar anything-tick-hash (make-hash-table :test 'equal))
919 (defvar anything-issued-errors nil)
920 (defvar anything-shortcut-keys nil)
921 (defvar anything-once-called-functions nil)
922 (defvar anything-follow-mode nil)
923 (defvar anything-let-variables nil)
925 ;; (@* "Utility: logging")
926 (defun anything-log (format-string &rest args)
927 "Log message if `debug-on-error' or `anything-debug' is non-nil.
928 Messages are written to the *Anythingn Log* buffer.
929 Arguments are same as `format'."
930 (when (or debug-on-error anything-debug)
931 (with-current-buffer (get-buffer-create "*Anything Log*")
932 (buffer-disable-undo)
933 (set (make-local-variable 'inhibit-read-only) t)
934 (goto-char (point-max))
935 (insert (let ((tm (current-time)))
936 (format "%s.%06d (%s) %s\n"
937 (format-time-string "%H:%M:%S" tm)
938 (nth 2 tm)
939 (anything-log-get-current-function)
940 (apply #'format (cons format-string args))))))))
941 (defmacro anything-log-eval (&rest exprs)
942 "Write each EXPR evaluation result to the *Anything Log* buffer."
943 `(anything-log-eval-internal ',exprs))
944 (defun anything-log-run-hook (hook)
945 (anything-log "executing %s" hook)
946 (when (boundp hook)
947 (anything-log-eval (symbol-value hook))
948 (anything-log-eval (default-value hook)))
949 (run-hooks hook)
950 (anything-log "executed %s" hook))
951 (defun anything-log-eval-internal (exprs)
952 (dolist (expr exprs)
953 (condition-case err
954 (anything-log "%S = %S" expr (eval expr))
955 (error (anything-log "%S = ERROR!" expr)))))
956 (defun anything-log-get-current-function ()
957 "Get function name calling `anything-log'.
958 The original idea is from `tramp-debug-message'."
959 (loop for btn from 1 to 40 ;avoid inf-loop
960 for btf = (second (backtrace-frame btn))
961 for fn = (if (symbolp btf) (symbol-name btf) "")
962 do (when (and (string-match "^anything" fn)
963 (not (string-match "^anything-\\(?:interpret\\|log\\|.*funcall\\)" fn)))
964 (return fn))))
966 (defun anything-log-error (&rest args)
967 "Accumulate error messages into `anything-issued-errors'."
968 (apply 'anything-log (concat "ERROR: " (car args)) (cdr args))
969 (let ((msg (apply 'format args)))
970 (unless (member msg anything-issued-errors)
971 (add-to-list 'anything-issued-errors msg))))
973 (defun anything-print-error-messages ()
974 "Print error messages in `anything-issued-errors'."
975 (message "%s" (mapconcat 'identity (reverse anything-issued-errors) "\n")))
980 ;; (anything-log "test")
981 ;; (switch-to-buffer-other-window "*Anything Log*")
983 ;; (@* "Programming Tools")
984 (defmacro anything-aif (test-form then-form &rest else-forms)
985 "Anaphoric if. Temporary variable `it' is the result of test-form."
986 `(let ((it ,test-form))
987 (if it ,then-form ,@else-forms)))
988 (put 'anything-aif 'lisp-indent-function 2)
990 (defun anything-mklist (obj)
991 "If OBJ is a list (but not lambda), return itself, otherwise make a list with one element."
992 (if (and (listp obj) (not (functionp obj)))
994 (list obj)))
996 ;; (@* "Anything API")
997 (defmacro anything-let (varlist &rest body)
998 "[OBSOLETE] Like `let'. Bind anything buffer local variables according to VARLIST then eval BODY."
999 `(anything-let-internal (anything-let-eval-varlist ',varlist)
1000 (lambda () ,@body)))
1001 (put 'anything-let 'lisp-indent-function 1)
1003 (defmacro anything-let* (varlist &rest body)
1004 "[OBSOLETE] Like `let*'. Bind anything buffer local variables according to VARLIST then eval BODY."
1005 `(anything-let-internal (anything-let*-eval-varlist ',varlist)
1006 (lambda () ,@body)))
1007 (put 'anything-let* 'lisp-indent-function 1)
1009 (defun anything-buffer-get ()
1010 "If *anything action* buffer is shown, return `anything-action-buffer', otherwise `anything-buffer'."
1011 (if (anything-action-window)
1012 anything-action-buffer
1013 anything-buffer))
1015 (defun anything-window ()
1016 "Window of `anything-buffer'."
1017 (get-buffer-window (anything-buffer-get) 'visible))
1019 (defun anything-action-window ()
1020 "Window of `anything-action-buffer'."
1021 (get-buffer-window anything-action-buffer 'visible))
1023 (defmacro with-anything-window (&rest body)
1024 `(let ((--tmpfunc-- (lambda () ,@body)))
1025 (if anything-test-mode
1026 (with-current-buffer (anything-buffer-get)
1027 (funcall --tmpfunc--))
1028 (with-selected-window (anything-window)
1029 (funcall --tmpfunc--)))))
1030 (put 'with-anything-window 'lisp-indent-function 0)
1032 (defun anything-deferred-action-function ()
1033 (dolist (f deferred-action-list) (funcall f)))
1034 (defmacro with-anything-restore-variables(&rest body)
1035 "Restore variables specified by `anything-restored-variables' after executing BODY . "
1036 `(let ((--orig-vars (mapcar (lambda (v) (cons v (symbol-value v))) anything-restored-variables))
1037 (deferred-action-function 'anything-deferred-action-function))
1038 (anything-log "save variables: %S" --orig-vars)
1039 (unwind-protect (progn ,@body)
1040 (loop for (var . value) in --orig-vars
1041 do (set var value))
1042 (anything-log "restore variables"))))
1043 (put 'with-anything-restore-variables 'lisp-indent-function 0)
1045 (defun* anything-attr (attribute-name &optional (src (anything-get-current-source)))
1046 "Get the value of ATTRIBUTE-NAME of SRC (source).
1047 if SRC is omitted, use current source.
1048 It is useful to write your sources."
1049 (anything-aif (assq attribute-name src)
1050 (cdr it)))
1052 (defun* anything-attr* (attribute-name &optional (src (anything-get-current-source)))
1053 "Get the value of ATTRIBUTE-NAME of SRC (source) and pass to `anything-interpret-value'.
1054 if SRC is omitted, use current source.
1055 It is useful to write your sources."
1056 (anything-interpret-value (anything-attr attribute-name src)))
1058 (defun* anything-attr-defined (attribute-name &optional (src (anything-get-current-source)))
1059 "Return non-nil if ATTRIBUTE-NAME of SRC (source) is defined.
1060 if SRC is omitted, use current source.
1061 It is useful to write your sources."
1062 (and (assq attribute-name src) t))
1064 (defun* anything-attrset (attribute-name value &optional (src (anything-get-current-source)))
1065 "Set the value of ATTRIBUTE-NAME of SRC (source) to VALUE.
1066 if SRC is omitted, use current source.
1067 It is useful to write your sources."
1068 (anything-aif (assq attribute-name src)
1069 (setcdr it value)
1070 (setcdr src (cons (cons attribute-name value) (cdr src))))
1071 value)
1073 ;; anything-set-source-filter
1075 ;; This function sets a filter for anything sources and it may be
1076 ;; called while anything is running. It can be used to toggle
1077 ;; displaying of sources dinamically. For example, additional keys
1078 ;; can be bound into `anything-map' to display only the file-related
1079 ;; results if there are too many matches from other sources and
1080 ;; you're after files only:
1082 ;; Shift+F shows only file results from some sources:
1084 ;; (define-key anything-map "F" 'anything-my-show-files-only)
1086 ;; (defun anything-my-show-files-only ()
1087 ;; (interactive)
1088 ;; (anything-set-source-filter '("File Name History"
1089 ;; "Files from Current Directory")))
1091 ;; Shift+A shows all results:
1093 ;; (define-key anything-map "A" 'anything-my-show-all)
1095 ;; (defun anything-my-show-all ()
1096 ;; (interactive)
1097 ;; (anything-set-source-filter nil))
1100 ;; Note that you have to prefix the functions with anything- prefix,
1101 ;; otherwise they won't be bound when Anything is used under
1102 ;; Iswitchb. The -my- part is added to avoid collisions with
1103 ;; existing Anything function names.
1105 (defun anything-set-source-filter (sources)
1106 "Sets the value of `anything-source-filter' and updates the list of results."
1107 (unless (and (listp sources)
1108 (loop for name in sources always (stringp name)))
1109 (error "invalid data in `anything-set-source-filter': %S" sources))
1110 (setq anything-source-filter sources)
1111 (anything-log-eval anything-source-filter)
1112 (anything-update))
1114 (defun anything-set-sources (sources &optional no-init no-update)
1115 "Set `anything-sources' during `anything' invocation.
1116 If NO-INIT is non-nil, skip executing init functions of SOURCES.
1117 If NO-UPDATE is non-nil, skip executing `anything-update'."
1118 (with-current-buffer anything-buffer
1119 (setq anything-compiled-sources nil
1120 anything-sources sources
1121 anything-last-sources-local sources)
1122 (anything-log-eval anything-compiled-sources anything-sources))
1123 (unless no-init (anything-funcall-foreach 'init))
1124 (unless no-update (anything-update)))
1126 (defvar anything-compile-source-functions
1127 '(anything-compile-source--type
1128 anything-compile-source--dummy
1129 anything-compile-source--disable-shortcuts
1130 anything-compile-source--candidates-in-buffer)
1131 "Functions to compile elements of `anything-sources' (plug-in).")
1133 (defun anything-get-sources ()
1134 "Return compiled `anything-sources', which is memoized.
1136 Attributes:
1138 - type
1139 `anything-type-attributes' are merged in.
1140 - candidates-buffer
1141 candidates, volatile and match attrubute are created.
1143 (cond
1144 ;; action
1145 ((anything-action-window)
1146 anything-sources)
1147 ;; memoized
1148 (anything-compiled-sources)
1149 ;; first time
1151 (prog1
1152 (setq anything-compiled-sources
1153 (anything-compile-sources anything-sources anything-compile-source-functions))
1154 (anything-log-eval anything-compiled-sources)))))
1156 (defun* anything-get-selection (&optional (buffer nil buffer-s) (force-display-part))
1157 "Return the currently selected item or nil.
1158 if BUFFER is nil or unspecified, use anything-buffer as default value.
1159 If FORCE-DISPLAY-PART is non-nil, return the display string."
1160 (setq buffer (if (and buffer buffer-s) buffer anything-buffer))
1161 (unless (anything-empty-buffer-p buffer)
1162 (with-current-buffer buffer
1163 (let ((selection
1164 (or (and (not force-display-part)
1165 (get-text-property (overlay-start
1166 anything-selection-overlay)
1167 'anything-realvalue))
1168 (let ((disp (buffer-substring-no-properties
1169 (overlay-start anything-selection-overlay)
1170 (1- (overlay-end anything-selection-overlay))))
1171 (source (anything-get-current-source)))
1172 (anything-aif (and (not force-display-part)
1173 (assoc-default 'display-to-real source))
1174 (anything-funcall-with-source source it disp)
1175 disp)))))
1176 (unless (equal selection "")
1177 (anything-log-eval selection)
1178 selection)))))
1180 (defun anything-get-action ()
1181 "Return the associated action for the selected candidate."
1182 (unless (anything-empty-buffer-p (anything-buffer-get))
1183 (anything-aif (anything-attr 'action-transformer)
1184 (anything-composed-funcall-with-source
1185 (anything-get-current-source) it (anything-attr 'action) (anything-get-selection))
1186 (anything-attr 'action))))
1188 (defun anything-get-current-source ()
1189 "Return the source for the current selection / in init/candidates/action/candidate-transformer/filtered-candidate-transformer function."
1190 (declare (special source))
1191 ;; The name `anything-get-current-source' should be used in init function etc.
1192 (if (and (boundp 'anything-source-name) (stringp anything-source-name))
1193 source
1194 (with-current-buffer (anything-buffer-get)
1195 (or (get-text-property (point) 'anything-source)
1196 (block exit
1197 ;; This goto-char shouldn't be necessary, but point is moved to
1198 ;; point-min somewhere else which shouldn't happen.
1199 (goto-char (overlay-start anything-selection-overlay))
1200 (let* ((header-pos (or (anything-get-previous-header-pos)
1201 (anything-get-next-header-pos)))
1202 (source-name
1203 (save-excursion
1204 (unless header-pos
1205 (message "No candidates")
1206 (return-from exit nil))
1207 (goto-char header-pos)
1208 (anything-current-line-contents))))
1209 (some (lambda (source)
1210 (if (equal (assoc-default 'name source) source-name)
1211 source))
1212 (anything-get-sources))))))))
1214 (defun anything-buffer-is-modified (buffer)
1215 "Return non-nil when BUFFER is modified since `anything' was invoked."
1216 (let* ((b (get-buffer buffer))
1217 (key (concat (buffer-name b) "/" (anything-attr 'name)))
1218 (source-tick (or (gethash key anything-tick-hash) 0))
1219 (buffer-tick (buffer-chars-modified-tick b))
1220 (modifiedp (/= source-tick buffer-tick)))
1221 (puthash key buffer-tick anything-tick-hash)
1222 (anything-log-eval buffer modifiedp)
1223 modifiedp))
1224 (defun anything-current-buffer-is-modified ()
1225 "Return non-nil when `anything-current-buffer' is modified since `anything' was invoked."
1226 (anything-buffer-is-modified anything-current-buffer))
1228 (defvar anything-quit nil)
1229 (defun anything-run-after-quit (function &rest args)
1230 "Perform an action after quitting `anything'.
1231 The action is to call FUNCTION with arguments ARGS."
1232 (setq anything-quit t)
1233 (anything-log-eval function args)
1234 (apply 'run-with-idle-timer 0 nil function args)
1235 (anything-exit-minibuffer))
1237 (defun define-anything-type-attribute (type definition &optional doc)
1238 "Register type attribute of TYPE as DEFINITION with DOC.
1239 DOC is displayed in `anything-type-attributes' docstring.
1241 Use this function is better than setting `anything-type-attributes' directly."
1242 (anything-add-type-attribute type definition)
1243 (and doc (anything-document-type-attribute type doc))
1244 nil)
1246 (defvaralias 'anything-attributes 'anything-additional-attributes)
1247 (defvar anything-additional-attributes nil
1248 "List of all `anything' attributes.")
1249 (defun anything-document-attribute (attribute short-doc &optional long-doc)
1250 "Register ATTRIBUTE documentation introduced by plug-in.
1251 SHORT-DOC is displayed beside attribute name.
1252 LONG-DOC is displayed below attribute name and short documentation."
1253 (if long-doc
1254 (setq short-doc (concat "(" short-doc ")"))
1255 (setq long-doc short-doc
1256 short-doc ""))
1257 (add-to-list 'anything-additional-attributes attribute t)
1258 (put attribute 'anything-attrdoc
1259 (concat "- " (symbol-name attribute) " " short-doc "\n\n" long-doc "\n")))
1260 (put 'anything-document-attribute 'lisp-indent-function 2)
1262 (defun anything-require-at-least-version (version)
1263 "Output error message unless anything.el is older than VERSION.
1264 This is suitable for anything applications."
1265 (when (and (string= "1." (substring version 0 2))
1266 (string-match "1\.\\([0-9]+\\)" anything-version)
1267 (< (string-to-number (match-string 1 anything-version))
1268 (string-to-number (substring version 2))))
1269 (error "Please update anything.el!!
1271 M-x auto-install-batch anything
1273 You must have auto-install.el too.
1274 http://www.emacswiki.org/cgi-bin/wiki/download/auto-install.el
1275 ")))
1277 (defun anything-interpret-value (value &optional source)
1278 "interpret VALUE as variable, function or literal.
1279 If VALUE is a function, call it with no arguments and return the value.
1280 If SOURCE is `anything' source, `anything-source-name' is source name.
1282 If VALUE is a variable, return the value.
1284 If VALUE is a symbol, but it is not a function or a variable, cause an error.
1286 Otherwise, return VALUE itself."
1287 (cond ((and source (functionp value))
1288 (anything-funcall-with-source source value))
1289 ((functionp value)
1290 (funcall value))
1291 ((and (symbolp value) (boundp value))
1292 (symbol-value value))
1293 ((symbolp value)
1294 (error "anything-interpret-value: Symbol must be a function or a variable"))
1296 value)))
1298 (defun anything-once (function &rest args)
1299 "Ensure FUNCTION with ARGS to be called once in `anything' session."
1300 (let ((spec (cons function args)))
1301 (unless (member spec anything-once-called-functions)
1302 (apply function args)
1303 (push spec anything-once-called-functions))))
1305 ;; (@* "Core: API helper")
1306 (defun anything-empty-buffer-p (&optional buffer)
1307 (zerop (buffer-size (and buffer (get-buffer buffer)))))
1309 (defun anything-let-eval-varlist (varlist)
1310 (mapcar (lambda (pair)
1311 (if (listp pair)
1312 (cons (car pair) (eval (cadr pair)))
1313 (cons pair nil)))
1314 varlist))
1315 (defun anything-let*-eval-varlist (varlist)
1316 (let ((vars (mapcar (lambda (pair) (or (car-safe pair) pair)) varlist)))
1317 (eval `(let ,vars
1318 ,@(mapcar (lambda (pair)
1319 (if (listp pair)
1320 `(setq ,(car pair) ,(cadr pair))
1321 `(setq ,pair nil)))
1322 varlist)
1323 (mapcar (lambda (v) (cons v (symbol-value v))) ',vars)))))
1324 (defun anything-let-internal (binding bodyfunc)
1325 "Evaluate BODYFUNC and Set BINDING to anything buffer-local variables.
1326 BINDING is a list of (VARNAME . VALUE) pair."
1327 (setq anything-let-variables binding)
1328 (unwind-protect
1329 (funcall bodyfunc)
1330 (setq anything-let-variables nil)))
1333 ;; (@* "Core: tools")
1334 (defun anything-current-line-contents ()
1335 "Current line strig without properties."
1336 (buffer-substring-no-properties (line-beginning-position) (line-end-position)))
1338 (defun anything-funcall-with-source (source func &rest args)
1339 "Call FUNC with ARGS with variable `anything-source-name' and `source' is bound.
1340 FUNC can be function list. Return the result of last function call."
1341 (let ((anything-source-name (assoc-default 'name source))
1342 result)
1343 (anything-log-eval anything-source-name func args)
1344 (dolist (func (if (functionp func) (list func) func) result)
1345 (setq result (apply func args)))))
1347 (defun anything-funcall-foreach (sym)
1348 "Call the sym function(s) for each source if any."
1349 (dolist (source (anything-get-sources))
1350 (anything-aif (assoc-default sym source)
1351 (anything-funcall-with-source source it))))
1353 (defun anything-normalize-sources (sources)
1354 "If SOURCES is only one source, make a list."
1355 (cond ((or (and sources ; avoid nil
1356 (symbolp sources))
1357 (and (listp sources) (assq 'name sources)))
1358 (list sources))
1359 (sources)
1360 (t anything-sources)))
1362 (defun anything-approximate-candidate-number ()
1363 "Approximate Number of candidates.
1364 It is used to check if candidate number is 0, 1, or 2+."
1365 (with-current-buffer anything-buffer
1366 (let ((lines (1- (line-number-at-pos (1- (point-max))))))
1367 (if (zerop lines)
1369 (save-excursion
1370 (goto-char (point-min))
1371 (forward-line 1)
1372 (if (anything-pos-multiline-p)
1373 (if (search-forward anything-candidate-separator nil t) 2 1)
1374 lines))))))
1376 (defmacro with-anything-quittable (&rest body)
1377 `(let (inhibit-quit)
1378 (condition-case v
1379 (progn ,@body)
1380 (quit (setq anything-quit t)
1381 (exit-minibuffer)
1382 (keyboard-quit)))))
1383 (put 'with-anything-quittable 'lisp-indent-function 0)
1385 (defun anything-compose (arg-lst func-lst)
1386 "Call each function in FUNC-LST with the arguments specified in ARG-LST.
1387 The result of each function will be the new `car' of ARG-LST.
1389 This function allows easy sequencing of transformer functions."
1390 (dolist (func func-lst)
1391 (setcar arg-lst (apply func arg-lst)))
1392 (car arg-lst))
1394 (defun anything-composed-funcall-with-source (source funcs &rest args)
1395 (if (functionp funcs)
1396 (apply 'anything-funcall-with-source source funcs args)
1397 (apply 'anything-funcall-with-source
1398 source (lambda (&rest args) (anything-compose args funcs)) args)))
1400 (defun anything-new-timer (variable timer)
1401 "Set new TIMER to VARIABLE. Old timer is cancelled."
1402 (anything-aif (symbol-value variable)
1403 (cancel-timer it))
1404 (set variable timer))
1406 ;; (@* "Core: entry point")
1407 (defconst anything-argument-keys '(:sources :input :prompt :resume :preselect :buffer :keymap))
1408 ;;;###autoload
1409 (defun anything (&rest plist)
1410 "Select anything. In Lisp program, some optional arguments can be used.
1412 PLIST is a list like (:key1 val1 :key2 val2 ...) or
1413 (&optional sources input prompt resume preselect buffer keymap).
1415 Basic keywords are the following:
1417 - :sources
1419 Temporary value of `anything-sources'. It also accepts a
1420 symbol, interpreted as a variable of an anything source. It
1421 also accepts an alist representing an anything source, which is
1422 detected by (assq 'name ANY-SOURCES)
1424 - :input
1426 Temporary value of `anything-pattern', ie. initial input of minibuffer.
1428 - :prompt
1430 Prompt other than \"pattern: \".
1432 - :resume
1434 If t, Resurrect previously instance of `anything'. Skip the initialization.
1435 If 'noresume, this instance of `anything' cannot be resumed.
1437 - :preselect
1439 Initially selected candidate. Specified by exact candidate or a regexp.
1440 Note that it is not working with delayed sources.
1442 - :buffer
1444 `anything-buffer' instead of *anything*.
1446 - :keymap
1448 `anything-map' for current `anything' session.
1451 Of course, conventional arguments are supported, the two are same.
1453 (anything :sources sources :input input :prompt prompt :resume resume
1454 :preselect preselect :buffer buffer :keymap keymap)
1455 (anything sources input prompt resume preselect buffer keymap)
1458 Other keywords are interpreted as local variables of this anything session.
1459 The `anything-' prefix can be omitted. For example,
1461 (anything :sources 'anything-c-source-buffers
1462 :buffer \"*buffers*\" :candidate-number-limit 10)
1464 means starting anything session with `anything-c-source-buffers'
1465 source in *buffers* buffer and set
1466 `anything-candidate-number-limit' to 10 as session local variable. "
1467 (interactive)
1468 (if (keywordp (car plist))
1469 (anything-let-internal
1470 (anything-parse-keys plist)
1471 (lambda ()
1472 (apply 'anything
1473 (mapcar (lambda (key) (plist-get plist key))
1474 anything-argument-keys))))
1475 (apply 'anything-internal plist)))
1477 (defun* anything-resume (&optional (any-buffer anything-last-buffer) buffer-pattern (any-resume t))
1478 "Resurrect previously invoked `anything'."
1479 (interactive)
1480 (when (or current-prefix-arg buffer-pattern)
1481 (setq any-buffer (anything-resume-select-buffer buffer-pattern)))
1482 (setq anything-compiled-sources nil)
1483 (anything
1484 (or (buffer-local-value 'anything-last-sources-local (get-buffer any-buffer))
1485 anything-last-sources anything-sources)
1486 (buffer-local-value 'anything-input-local (get-buffer any-buffer)) nil any-resume nil any-buffer))
1488 ;;; rubikitch: experimental
1489 ;;; I use this and check it whether I am convenient.
1490 ;;; I may introduce an option to control the behavior.
1491 (defun* anything-resume-window-only (&optional (any-buffer anything-last-buffer) buffer-pattern)
1492 (interactive)
1493 (anything-resume any-buffer buffer-pattern 'window-only))
1495 ;;;###autoload
1496 (defun anything-at-point (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer)
1497 "Same as `anything' except when C-u is pressed, the initial input is the symbol at point."
1498 (interactive)
1499 (anything any-sources
1500 (if current-prefix-arg
1501 (concat "\\b" (thing-at-point 'symbol) "\\b"
1502 (if (featurep 'anything-match-plugin) " " ""))
1503 any-input)
1504 any-prompt any-resume any-preselect any-buffer))
1506 ;;;###autoload
1507 (defun anything-other-buffer (any-sources any-buffer)
1508 "Simplified interface of `anything' with other `anything-buffer'"
1509 (anything any-sources nil nil nil nil any-buffer))
1511 ;;; (@* "Core: entry point helper")
1512 (defun anything-internal (&optional any-sources any-input any-prompt any-resume any-preselect any-buffer any-keymap)
1513 "Older interface of `anything'. It is called by `anything'."
1514 (anything-log "++++++++++++++++++++++++++++++++++++++++++++++++++++++++")
1515 (anything-log-eval any-prompt any-preselect any-buffer any-keymap)
1516 (condition-case v
1517 (let ( ;; It is needed because `anything-source-name' is non-nil
1518 ;; when `anything' is invoked by action. Awful global scope.
1519 anything-source-name anything-in-persistent-action
1520 anything-quit
1521 (case-fold-search t)
1522 (anything-buffer (or any-buffer anything-buffer))
1523 ;; cua-mode ; avoid error when region is selected
1525 (with-anything-restore-variables
1526 (anything-initialize-1 any-resume any-input any-sources)
1527 (anything-display-buffer anything-buffer)
1528 (anything-log "show prompt")
1529 (unwind-protect
1530 (anything-read-pattern-maybe any-prompt any-input any-preselect any-resume any-keymap)
1531 (anything-cleanup)))
1532 (prog1 (unless anything-quit (anything-execute-selection-action-1))
1533 (anything-log "end session --------------------------------------------")))
1534 (quit
1535 (anything-on-quit)
1536 (anything-log "end session (quit) -------------------------------------")
1537 nil)))
1541 (defun anything-parse-keys (keys)
1542 (loop for (key value &rest _) on keys by #'cddr
1543 for symname = (substring (symbol-name key) 1)
1544 for sym = (intern (if (string-match "^anything-" symname)
1545 symname
1546 (concat "anything-" symname)))
1547 unless (memq key anything-argument-keys)
1548 collect (cons sym value)))
1550 (defun anything-resume-p (any-resume)
1551 "Whethre current anything session is resumed or not."
1552 (memq any-resume '(t window-only)))
1554 (defvar anything-buffers nil
1555 "All of `anything-buffer' in most recently used order.")
1556 (defun anything-initialize-1 (any-resume any-input any-sources)
1557 "The real initialization of `anything'.
1559 This function name should be `anything-initialize', but anything
1560 extensions may advice `anything-initalize'. I cannot rename, sigh."
1561 (anything-log "start initialization: any-resume=%S any-input=%S" any-resume any-input)
1562 (anything-frame/window-configuration 'save)
1563 (setq anything-sources (anything-normalize-sources any-sources))
1564 (anything-log "sources = %S" anything-sources)
1565 (anything-hooks 'setup)
1566 (anything-current-position 'save)
1567 (if (anything-resume-p any-resume)
1568 (anything-initialize-overlays (anything-buffer-get))
1569 (anything-initialize))
1570 (unless (eq any-resume 'noresume)
1571 (anything-recent-push anything-buffer 'anything-buffers)
1572 (setq anything-last-buffer anything-buffer))
1573 (when any-input (setq anything-input any-input anything-pattern any-input))
1574 (and (anything-resume-p any-resume) (anything-funcall-foreach 'resume))
1575 (anything-log "end initialization"))
1577 (defun anything-execute-selection-action-1 ()
1578 (unwind-protect
1579 (anything-execute-selection-action)
1580 (anything-aif (get-buffer anything-action-buffer)
1581 (kill-buffer it))
1582 (anything-log-run-hook 'anything-after-action-hook)))
1584 (defun anything-on-quit ()
1585 (setq minibuffer-history (cons anything-input minibuffer-history))
1586 (anything-current-position 'restore))
1588 (defun anything-resume-select-buffer (input)
1589 (anything '(((name . "Resume anything buffer")
1590 (candidates . anything-buffers)
1591 (action . identity)))
1592 input nil 'noresume nil "*anything resume*"))
1594 (defun anything-recent-push (elt list-var)
1595 "Add ELT to the value of LIST-VAR as most recently used value."
1596 (let ((m (member elt (symbol-value list-var))))
1597 (and m (set list-var (delq (car m) (symbol-value list-var))))
1598 (push elt (symbol-value list-var))))
1600 ;;; (@* "Core: Accessors")
1601 ;;; rubikitch: I love to create functions to control variables.
1602 (defvar anything-current-position nil
1603 "Cons of (point) and (window-start) when `anything' is invoked.
1604 It is needed because restoring position when `anything' is keyboard-quitted.")
1605 (defun anything-current-position (save-or-restore)
1606 (case save-or-restore
1607 (save
1608 (setq anything-current-position (cons (point) (window-start))))
1609 (restore
1610 (goto-char (car anything-current-position))
1611 (set-window-start (selected-window) (cdr anything-current-position)))))
1613 ;;; FIXME I want to remove them. But anything-iswitchb uses them.
1614 (defun anything-current-frame/window-configuration ()
1615 (funcall (cdr anything-save-configuration-functions)))
1616 (defun anything-set-frame/window-configuration (conf)
1617 (funcall (car anything-save-configuration-functions) conf))
1619 (declare-function 'anything-frame/window-configuration "anything")
1620 (lexical-let (conf)
1621 (defun anything-frame/window-configuration (save-or-restore)
1622 (anything-log-eval anything-save-configuration-functions)
1623 (case save-or-restore
1624 (save (setq conf (funcall (cdr anything-save-configuration-functions))))
1625 (restore (funcall (car anything-save-configuration-functions) conf)))))
1627 ;; (@* "Core: Display *anything* buffer")
1628 (defun anything-display-buffer (buf)
1629 "Display *anything* buffer."
1630 (funcall (with-current-buffer buf anything-display-function) buf))
1632 (defun anything-default-display-buffer (buf)
1633 (funcall (if anything-samewindow 'switch-to-buffer 'pop-to-buffer) buf))
1635 ;; (@* "Core: initialize")
1636 (defun anything-initialize ()
1637 "Initialize anything settings and set up the anything buffer."
1638 (anything-log-run-hook 'anything-before-initialize-hook)
1639 (setq anything-once-called-functions nil)
1640 (setq anything-delayed-init-executed nil)
1641 (setq anything-current-buffer (current-buffer))
1642 (setq anything-buffer-file-name buffer-file-name)
1643 (setq anything-issued-errors nil)
1644 (setq anything-compiled-sources nil)
1645 (setq anything-saved-current-source nil)
1646 ;; Call the init function for sources where appropriate
1647 (anything-funcall-foreach 'init)
1649 (setq anything-pattern "")
1650 (setq anything-input "")
1651 (setq anything-candidate-cache nil)
1652 (setq anything-last-sources anything-sources)
1654 (anything-create-anything-buffer)
1655 (anything-log-run-hook 'anything-after-initialize-hook))
1657 (defun anything-read-pattern-maybe (any-prompt any-input any-preselect any-resume any-keymap)
1658 (if (anything-resume-p any-resume) (anything-mark-current-line) (anything-update))
1659 (select-frame-set-input-focus (window-frame (minibuffer-window)))
1660 (anything-preselect any-preselect)
1661 (let ((minibuffer-local-map
1662 (with-current-buffer (anything-buffer-get)
1663 (and any-keymap (set (make-local-variable 'anything-map) any-keymap))
1664 anything-map)))
1665 (anything-log-eval (anything-approximate-candidate-number)
1666 anything-execute-action-at-once-if-one
1667 anything-quit-if-no-candidate)
1668 (cond ((and anything-execute-action-at-once-if-one
1669 (= (anything-approximate-candidate-number) 1))
1670 (ignore))
1671 ((and anything-quit-if-no-candidate
1672 (= (anything-approximate-candidate-number) 0))
1673 (setq anything-quit t)
1674 (and (functionp anything-quit-if-no-candidate)
1675 (funcall anything-quit-if-no-candidate)))
1677 (read-string (or any-prompt "pattern: ") any-input)))))
1679 (defun anything-create-anything-buffer (&optional test-mode)
1680 "Create newly created `anything-buffer'.
1681 If TEST-MODE is non-nil, clear `anything-candidate-cache'."
1682 (when test-mode
1683 (setq anything-candidate-cache nil))
1684 (with-current-buffer (get-buffer-create anything-buffer)
1685 (anything-log "kill local variables: %S" (buffer-local-variables))
1686 (kill-all-local-variables)
1687 (buffer-disable-undo)
1688 (erase-buffer)
1689 (set (make-local-variable 'inhibit-read-only) t)
1690 (set (make-local-variable 'anything-last-sources-local) anything-sources)
1691 (set (make-local-variable 'anything-follow-mode) nil)
1692 (set (make-local-variable 'anything-display-function) anything-display-function)
1693 (anything-log-eval anything-display-function anything-let-variables)
1694 (loop for (var . val) in anything-let-variables
1695 do (set (make-local-variable var) val))
1697 (setq cursor-type nil)
1698 (setq mode-name "Anything"))
1699 (anything-initialize-overlays anything-buffer)
1700 (get-buffer anything-buffer))
1702 (defun anything-initialize-overlays (buffer)
1703 (anything-log "overlay setup")
1704 (if anything-selection-overlay
1705 ;; make sure the overlay belongs to the anything buffer if
1706 ;; it's newly created
1707 (move-overlay anything-selection-overlay (point-min) (point-min)
1708 (get-buffer buffer))
1710 (setq anything-selection-overlay
1711 (make-overlay (point-min) (point-min) (get-buffer buffer)))
1712 (overlay-put anything-selection-overlay 'face anything-selection-face))
1714 (cond (anything-enable-shortcuts
1715 (setq anything-shortcut-keys
1716 (assoc-default anything-enable-shortcuts anything-shortcut-keys-alist))
1717 (unless anything-digit-overlays
1718 (setq anything-digit-overlays
1719 (loop for key across anything-shortcut-keys
1720 for overlay = (make-overlay (point-min) (point-min) (get-buffer buffer))
1721 do (overlay-put overlay 'before-string
1722 (format "%s - " (upcase (make-string 1 key))))
1723 collect overlay))))
1724 (anything-digit-overlays
1725 (mapc 'delete-overlay anything-digit-overlays)
1726 (setq anything-digit-overlays nil))))
1728 (defun anything-hooks (setup-or-cleanup)
1729 (let ((hooks '((deferred-action-list anything-check-minibuffer-input)
1730 (minibuffer-setup-hook anything-print-error-messages))))
1731 (if (eq setup-or-cleanup 'setup)
1732 (dolist (args hooks) (apply 'add-hook args))
1733 (dolist (args (reverse hooks)) (apply 'remove-hook args)))))
1735 ;; (@* "Core: clean up")
1736 ;;; TODO move
1737 (defun anything-cleanup ()
1738 "Clean up the mess."
1739 (anything-log "start cleanup")
1740 (with-current-buffer anything-buffer
1741 (setq cursor-type t))
1742 (bury-buffer anything-buffer)
1743 (anything-funcall-foreach 'cleanup)
1744 (anything-new-timer 'anything-check-minibuffer-input-timer nil)
1745 (anything-kill-async-processes)
1746 (anything-log-run-hook 'anything-cleanup-hook)
1747 (anything-hooks 'cleanup)
1748 (anything-frame/window-configuration 'restore))
1750 ;; (@* "Core: input handling")
1751 (defun anything-check-minibuffer-input ()
1752 "Extract input string from the minibuffer and check if it needs
1753 to be handled."
1754 (if (or (not anything-input-idle-delay) (anything-action-window))
1755 (anything-check-minibuffer-input-1)
1756 (anything-new-timer
1757 'anything-check-minibuffer-input-timer
1758 (run-with-idle-timer anything-input-idle-delay nil 'anything-check-minibuffer-input-1))))
1760 (defun anything-check-minibuffer-input-1 ()
1761 (with-anything-quittable
1762 (with-selected-window (minibuffer-window)
1763 (anything-check-new-input (minibuffer-contents)))))
1765 (defun anything-check-new-input (input)
1766 "Check input string and update the anything buffer if
1767 necessary."
1768 (unless (equal input anything-pattern)
1769 (setq anything-pattern input)
1770 (unless (anything-action-window)
1771 (setq anything-input anything-pattern))
1772 (anything-log-eval anything-pattern anything-input)
1773 (anything-update)))
1775 ;; (@* "Core: source compiler")
1776 (defvar anything-compile-source-functions-default anything-compile-source-functions
1777 "Plug-ins this file provides.")
1778 (defun anything-compile-sources (sources funcs)
1779 "Compile sources (`anything-sources') with funcs (`anything-compile-source-functions').
1780 Anything plug-ins are realized by this function."
1781 (mapcar
1782 (lambda (source)
1783 (loop with source = (if (listp source) source (symbol-value source))
1784 for f in funcs
1785 do (setq source (funcall f source))
1786 finally (return source)))
1787 sources))
1789 ;; (@* "Core: plug-in attribute documentation hack")
1791 ;; `anything-document-attribute' is public API.
1792 (defadvice documentation-property (after anything-document-attribute activate)
1793 "Hack to display plug-in attributes' documentation as `anything-sources' docstring."
1794 (when (eq symbol 'anything-sources)
1795 (setq ad-return-value
1796 (concat ad-return-value "\n"
1797 (mapconcat (lambda (sym) (get sym 'anything-attrdoc))
1798 anything-additional-attributes
1799 "\n")))))
1800 ;; (describe-variable 'anything-sources)
1801 ;; (documentation-property 'anything-sources 'variable-documentation)
1802 ;; (progn (ad-disable-advice 'documentation-property 'after 'anything-document-attribute) (ad-update 'documentation-property))
1804 ;; (@* "Core: all candidates")
1805 (defun anything-process-delayed-init (source)
1806 (let ((name (assoc-default 'name source)))
1807 (unless (member name anything-delayed-init-executed)
1808 (anything-aif (assoc-default 'delayed-init source)
1809 (with-current-buffer anything-current-buffer
1810 (anything-funcall-with-source source it)
1811 (dolist (f (if (functionp it) (list it) it))
1812 (add-to-list 'anything-delayed-init-executed name)))))))
1814 (defun anything-get-candidates (source)
1815 "Retrieve and return the list of candidates from
1816 SOURCE."
1817 (anything-process-delayed-init source)
1818 (let* ((candidate-source (assoc-default 'candidates source))
1819 (type-error (lambda ()
1820 (error (concat "Candidates must either be a function, "
1821 " a variable or a list: %s")
1822 candidate-source)))
1823 (candidates (condition-case err
1824 (anything-interpret-value candidate-source source)
1825 (error (funcall type-error)))))
1826 (cond ((processp candidates) candidates)
1827 ((listp candidates) (anything-transform-candidates candidates source))
1828 (t (funcall type-error)))))
1831 (defun anything-get-cached-candidates (source)
1832 "Return the cached value of candidates for SOURCE.
1833 Cache the candidates if there is not yet a cached value."
1834 (let* ((name (assoc-default 'name source))
1835 (candidate-cache (assoc name anything-candidate-cache)))
1836 (cond (candidate-cache
1837 (anything-log "use cached candidates")
1838 (cdr candidate-cache))
1840 (anything-log "calculate candidates")
1841 (let ((candidates (anything-get-candidates source)))
1842 (cond ((processp candidates)
1843 (push (cons candidates
1844 (append source
1845 (list (cons 'item-count 0)
1846 (cons 'incomplete-line ""))))
1847 anything-async-processes)
1848 (set-process-filter candidates 'anything-output-filter)
1849 (setq candidates nil))
1850 ((not (assoc 'volatile source))
1851 (setq candidate-cache (cons name candidates))
1852 (push candidate-cache anything-candidate-cache)))
1853 candidates)))))
1855 ;;; (@* "Core: candidate transformers")
1856 (defun anything-process-candidate-transformer (candidates source)
1857 (anything-aif (assoc-default 'candidate-transformer source)
1858 (anything-composed-funcall-with-source source it candidates)
1859 candidates))
1860 (defun anything-process-filtered-candidate-transformer (candidates source)
1861 (anything-aif (assoc-default 'filtered-candidate-transformer source)
1862 (anything-composed-funcall-with-source source it candidates source)
1863 candidates))
1864 (defun anything-process-filtered-candidate-transformer-maybe (candidates source process-p)
1865 (if process-p
1866 (anything-process-filtered-candidate-transformer candidates source)
1867 candidates))
1868 (defun anything-process-real-to-display (candidates source)
1869 (anything-aif (assoc-default 'real-to-display source)
1870 (setq candidates (anything-funcall-with-source
1871 source 'mapcar
1872 (lambda (cand_)
1873 (if (consp cand_)
1874 ;; override DISPLAY from candidate-transformer
1875 (cons (funcall it (cdr cand_)) (cdr cand_))
1876 (cons (funcall it cand_) cand_)))
1877 candidates))
1878 candidates))
1879 (defun anything-transform-candidates (candidates source &optional process-p)
1880 "Transform CANDIDATES according to candidate transformers."
1881 (anything-process-real-to-display
1882 (anything-process-filtered-candidate-transformer-maybe
1883 (anything-process-candidate-transformer candidates source) source process-p)
1884 source))
1887 ;; (@* "Core: narrowing candidates")
1888 (defun anything-candidate-number-limit (source)
1889 "`anything-candidate-number-limit' variable may be overridden by SOURCE.
1890 If (candidate-number-limit) is in SOURCE, show all candidates in SOURCE,
1891 ie. cancel the effect of `anything-candidate-number-limit'."
1892 (anything-aif (assq 'candidate-number-limit source)
1893 (or (cdr it) 99999999)
1894 (or anything-candidate-number-limit 99999999)))
1896 (defconst anything-default-match-functions
1897 (list (lambda (candidate)
1898 (string-match anything-pattern candidate))))
1900 (defun anything-compute-matches (source)
1901 "Compute matches from SOURCE according to its settings."
1902 (if debug-on-error
1903 (anything-compute-matches-internal source)
1904 (condition-case v
1905 (anything-compute-matches-internal source)
1906 (error (anything-log-error
1907 "anything-compute-matches: error when processing source: %s"
1908 (assoc-default 'name source))
1909 nil))))
1911 (defun anything-candidate-get-display (candidate)
1912 "Get display part (searched) from CANDIDATE.
1913 CANDIDATE is a string, a symbol, or (DISPLAY . REAL) cons cell."
1914 (format "%s" (or (car-safe candidate) candidate)))
1916 (defun anything-process-pattern-transformer (pattern source)
1917 (anything-aif (assoc-default 'pattern-transformer source)
1918 (anything-composed-funcall-with-source source it pattern)
1919 pattern))
1921 (defun anything-match-functions (source)
1922 (or (assoc-default 'match source)
1923 anything-default-match-functions))
1925 (defmacro anything-accumulate-candidates-internal (cand newmatches hash item-count limit)
1926 "INTERNAL: add CAND (ITEM-COUNT th match) into NEWMATCHES.
1927 Use HASH to uniq NEWMATCHES.
1928 if ITEM-COUNT reaches LIMIT, exit from inner loop."
1929 `(unless (gethash ,cand ,hash)
1930 (puthash ,cand t ,hash)
1931 (push ,cand ,newmatches)
1932 (incf ,item-count)
1933 (when (= ,item-count ,limit)
1934 (setq exit t)
1935 (return))))
1938 (defun anything-compute-matches-internal (source)
1939 (let ((matchfns (anything-match-functions source))
1940 (anything-source-name (assoc-default 'name source))
1941 (limit (anything-candidate-number-limit source))
1942 (anything-pattern (anything-process-pattern-transformer anything-pattern source))
1943 matches)
1944 (cond ((or (equal anything-pattern "") (equal matchfns '(identity)))
1945 (setq matches (anything-get-cached-candidates source))
1946 (if (> (length matches) limit)
1947 (setq matches (subseq matches 0 limit))))
1949 (condition-case nil
1950 (let ((item-count 0)
1951 (cands (anything-get-cached-candidates source))
1952 exit newmatches)
1953 (clrhash anything-match-hash)
1954 (dolist (match matchfns)
1955 (dolist (candidate cands)
1956 (when (funcall match (anything-candidate-get-display candidate))
1957 (anything-accumulate-candidates-internal
1958 candidate newmatches anything-match-hash item-count limit)))
1959 (setq matches (append matches (reverse newmatches)))
1960 (if exit (return))))
1962 (invalid-regexp (setq matches nil)))))
1963 (anything-process-filtered-candidate-transformer matches source)))
1965 ;; (anything '(((name . "error")(candidates . (lambda () (hage))) (action . identity))))
1967 (defun anything-process-source (source)
1968 "Display matches from SOURCE according to its settings."
1969 (anything-log-eval (assoc-default 'name source))
1970 (if (assq 'direct-insert-match source) ;experimental
1971 (anything-process-source--direct-insert-match source)
1972 (let ((matches (anything-compute-matches source)))
1973 (when matches
1974 (when anything-test-mode
1975 (setq anything-test-candidate-list
1976 `(,@anything-test-candidate-list
1977 (,(assoc-default 'name source)
1978 ,matches))))
1979 (anything-insert-header-from-source source)
1980 (if (not (assq 'multiline source))
1981 (mapc 'anything-insert-match-with-digit-overlay matches)
1982 (let ((start (point)) separate)
1983 (dolist (match matches)
1984 (if separate
1985 (anything-insert-candidate-separator)
1986 (setq separate t))
1987 (anything-insert-match-with-digit-overlay match))
1988 (put-text-property start (point) 'anything-multiline t)))))))
1990 (defun anything-insert-match-with-digit-overlay (match)
1991 (declare (special source))
1992 (anything-put-digit-overlay-maybe)
1993 (anything-insert-match match 'insert source))
1995 (defun anything-put-digit-overlay-maybe ()
1996 (when (and anything-enable-shortcuts
1997 (not (eq anything-digit-shortcut-count
1998 (length anything-digit-overlays))))
1999 (move-overlay (nth anything-digit-shortcut-count
2000 anything-digit-overlays)
2001 (line-beginning-position)
2002 (line-beginning-position))
2003 (incf anything-digit-shortcut-count)))
2005 (defun anything-process-source--direct-insert-match (source)
2006 "[EXPERIMENTAL] Insert candidates from `anything-candidate-buffer'"
2007 (anything-log-eval (assoc-default 'name source))
2008 (let ((anything-source-name (assoc-default 'name source))
2009 content-buf)
2010 (funcall (assoc-default 'candidates source))
2011 (setq content-buf (anything-candidate-buffer))
2012 (unless (anything-empty-buffer-p content-buf)
2013 (anything-insert-header-from-source source)
2014 (insert-buffer-substring content-buf)
2015 ;; TODO call anything-put-digit-overlay-maybe with loop
2018 (defun anything-process-delayed-sources (delayed-sources)
2019 "Process delayed sources if the user is idle for
2020 `anything-idle-delay' seconds."
2021 (with-anything-quittable
2022 (anything-log-eval (mapcar (lambda (s) (assoc-default 'name s)) delayed-sources))
2023 (when (sit-for (if anything-input-idle-delay
2024 (max 0 (- anything-idle-delay anything-input-idle-delay))
2025 anything-idle-delay))
2026 (with-current-buffer anything-buffer
2027 (save-excursion
2028 (goto-char (point-max))
2029 (mapc 'anything-process-source delayed-sources)
2030 (when (and (not (anything-empty-buffer-p))
2031 ;; no selection yet
2032 (= (overlay-start anything-selection-overlay)
2033 (overlay-end anything-selection-overlay)))
2034 (goto-char (point-min))
2035 (anything-next-line)))
2036 (save-excursion
2037 (goto-char (point-min))
2038 (anything-log-run-hook 'anything-update-hook))
2039 (anything-maybe-fit-frame)))))
2041 ;; (@* "Core: *anything* buffer contents")
2042 (defvar anything-input-local nil)
2043 (defun anything-update ()
2044 "Update the list of matches in the anything buffer according to
2045 the current pattern."
2046 (anything-log "start update")
2047 (setq anything-digit-shortcut-count 0)
2048 (anything-kill-async-processes)
2049 (with-current-buffer (anything-buffer-get)
2050 (set (make-local-variable 'anything-input-local) anything-pattern)
2051 (erase-buffer)
2052 (when anything-enable-shortcuts
2053 (mapc 'delete-overlay anything-digit-overlays))
2054 (let (delayed-sources)
2055 (unwind-protect
2056 (setq delayed-sources
2057 (loop for source in (remove-if-not 'anything-update-source-p
2058 (anything-get-sources))
2059 if (anything-delayed-source-p source)
2060 collect source
2061 else do (anything-process-source source)))
2062 (anything-log-eval
2063 (mapcar (lambda (s) (assoc-default 'name s)) delayed-sources))
2064 (anything-update-move-first-line)
2065 (if anything-test-mode
2066 (mapc 'anything-process-source delayed-sources)
2067 (anything-maybe-fit-frame)
2068 (when delayed-sources
2069 (run-with-idle-timer (if (featurep 'xemacs) 0.1 0)
2071 'anything-process-delayed-sources
2072 delayed-sources))
2073 ;; FIXME I want to execute anything-after-update-hook
2074 ;; AFTER processing delayed sources
2075 (anything-log-run-hook 'anything-after-update-hook))
2076 (anything-log "end update")))))
2078 (defun anything-update-source-p (source)
2079 (and (or (not anything-source-filter)
2080 (member (assoc-default 'name source) anything-source-filter))
2081 (>= (length anything-pattern)
2082 (anything-aif (assoc 'requires-pattern source)
2083 (or (cdr it) 1)
2084 0))))
2085 (defun anything-delayed-source-p (source)
2086 (or (assoc 'delayed source)
2087 (and anything-quick-update
2088 (< (window-height (get-buffer-window (current-buffer)))
2089 (line-number-at-pos (point-max))))))
2091 (defun anything-update-move-first-line ()
2092 (goto-char (point-min))
2093 (save-excursion (anything-log-run-hook 'anything-update-hook))
2094 (anything-next-line))
2096 (defun anything-force-update ()
2097 "Recalculate and update candidates.
2098 If current source has `update' attribute, a function without argument, call it before update."
2099 (interactive)
2100 (let ((source (anything-get-current-source)))
2101 (anything-aif (anything-funcall-with-source source 'anything-candidate-buffer)
2102 (kill-buffer it))
2103 (dolist (attr '(update init))
2104 (anything-aif (assoc-default attr source)
2105 (anything-funcall-with-source source it)))
2106 (anything-remove-candidate-cache source)
2107 (let ((selection (anything-get-selection nil t)))
2108 (anything-update)
2109 (anything-keep-selection source selection))))
2111 (defun anything-keep-selection (source selection)
2112 (with-anything-window
2113 (anything-goto-source source)
2114 (forward-char -1) ;back to \n
2115 (if (search-forward (concat "\n" selection "\n") nil t)
2116 (forward-line -1)
2117 (goto-char (point-min))
2118 (forward-line 1))
2119 (anything-mark-current-line)))
2121 (defun anything-remove-candidate-cache (source)
2122 (setq anything-candidate-cache
2123 (delete (assoc (assoc-default 'name source) anything-candidate-cache)
2124 anything-candidate-cache)))
2126 (defun anything-insert-match (match insert-function source)
2127 "Insert MATCH into the anything buffer. If MATCH is a list then
2128 insert the string inteneded to appear on the display and store
2129 the real value in a text property."
2130 (let ((start (line-beginning-position (point)))
2131 (string (or (car-safe match) match))
2132 (realvalue (cdr-safe match)))
2133 (when (symbolp string) (setq string (symbol-name string)))
2134 (when (stringp string)
2135 (funcall insert-function string)
2136 ;; Some sources with candidates-in-buffer have already added
2137 ;; 'anything-realvalue property when creating candidate buffer.
2138 (unless (get-text-property start 'anything-realvalue)
2139 (and realvalue
2140 (put-text-property start (line-end-position)
2141 'anything-realvalue realvalue)))
2142 (when anything-source-in-each-line-flag
2143 (put-text-property start (line-end-position) 'anything-source source))
2144 (funcall insert-function "\n"))))
2146 (defun anything-insert-header-from-source (source)
2147 (let ((name (assoc-default 'name source)))
2148 (anything-insert-header
2149 name
2150 (anything-aif (assoc-default 'header-name source)
2151 (anything-funcall-with-source source it name)))))
2153 (defun anything-insert-header (name &optional display-string)
2154 "Insert header of source NAME into the anything buffer."
2155 (unless (bobp)
2156 (let ((start (point)))
2157 (insert "\n")
2158 (put-text-property start (point) 'anything-header-separator t)))
2160 (let ((start (point)))
2161 (insert name)
2162 (put-text-property (line-beginning-position)
2163 (line-end-position) 'anything-header t)
2164 (when display-string
2165 (overlay-put (make-overlay (line-beginning-position) (line-end-position))
2166 'display display-string))
2167 (insert "\n")
2168 (put-text-property start (point) 'face anything-header-face)))
2171 (defun anything-insert-candidate-separator ()
2172 "Insert separator of candidates into the anything buffer."
2173 (insert anything-candidate-separator)
2174 (put-text-property (line-beginning-position)
2175 (line-end-position) 'anything-candidate-separator t)
2176 (insert "\n"))
2181 ;; (@* "Core: async process")
2182 (defun anything-output-filter (process string)
2183 "Process output from PROCESS."
2184 (anything-output-filter-1 (assoc process anything-async-processes) string))
2186 (defun anything-output-filter-1 (process-assoc string)
2187 (anything-log-eval string)
2188 (with-current-buffer anything-buffer
2189 (let ((source (cdr process-assoc)))
2190 (save-excursion
2191 (anything-aif (assoc-default 'insertion-marker source)
2192 (goto-char it)
2193 (goto-char (point-max))
2194 (anything-insert-header-from-source source)
2195 (setcdr process-assoc
2196 (append source `((insertion-marker . ,(point-marker))))))
2197 (anything-output-filter--process-source
2198 (car process-assoc) string source
2199 (anything-candidate-number-limit source))))
2200 (anything-output-filter--post-process)))
2202 (defun anything-output-filter--process-source (process string source limit)
2203 (dolist (candidate (anything-transform-candidates
2204 (anything-output-filter--collect-candidates
2205 (split-string string "\n")
2206 (assoc 'incomplete-line source))
2207 source t))
2208 (anything-insert-match candidate 'insert-before-markers source)
2209 (incf (cdr (assoc 'item-count source)))
2210 (when (>= (assoc-default 'item-count source) limit)
2211 (anything-kill-async-process process)
2212 (return))))
2214 (defun anything-output-filter--collect-candidates (lines incomplete-line-info)
2215 (anything-log-eval (cdr incomplete-line-info))
2216 (butlast
2217 (loop for line in lines collect
2218 (if (cdr incomplete-line-info)
2219 (prog1
2220 (concat (cdr incomplete-line-info) line)
2221 (setcdr incomplete-line-info nil))
2222 line)
2223 finally (setcdr incomplete-line-info line))))
2225 (defun anything-output-filter--post-process ()
2226 (anything-maybe-fit-frame)
2227 (anything-log-run-hook 'anything-update-hook)
2228 (if (bobp)
2229 (anything-next-line)
2230 (save-selected-window
2231 (select-window (get-buffer-window anything-buffer 'visible))
2232 (anything-mark-current-line))))
2235 (defun anything-kill-async-processes ()
2236 "Kill all known asynchronous processes according to
2237 `anything-async-processes'."
2238 "Kill locate process."
2239 (mapc 'anything-kill-async-process (mapcar 'car anything-async-processes))
2240 (setq anything-async-processes nil))
2243 (defun anything-kill-async-process (process)
2244 "Kill PROCESS and detach the associated functions."
2245 (set-process-filter process nil)
2246 (delete-process process))
2249 ;; (@* "Core: action")
2250 (defun anything-execute-selection-action (&optional selection action preserve-saved-action)
2251 "If a candidate was selected then perform the associated
2252 action."
2253 (anything-log "executing action")
2254 (setq action (anything-get-default-action
2255 (or action
2256 anything-saved-action
2257 (if (get-buffer anything-action-buffer)
2258 (anything-get-selection anything-action-buffer)
2259 (anything-get-action)))))
2260 (let ((source (or anything-saved-current-source (anything-get-current-source))))
2261 (setq selection (or selection
2262 (anything-get-selection)
2263 (and (assoc 'accept-empty source) "")))
2264 (unless preserve-saved-action (setq anything-saved-action nil))
2265 (if (and selection action)
2266 (anything-funcall-with-source source action selection))))
2268 (defun anything-get-default-action (action)
2269 (if (and (listp action) (not (functionp action)))
2270 (cdar action)
2271 action))
2273 (defun anything-select-action ()
2274 "Select an action for the currently selected candidate.
2275 If action buffer is selected, back to the anything buffer."
2276 (interactive)
2277 (cond ((get-buffer-window anything-action-buffer 'visible)
2278 (set-window-buffer (get-buffer-window anything-action-buffer) anything-buffer)
2279 (kill-buffer anything-action-buffer)
2280 (anything-set-pattern anything-input))
2282 (setq anything-saved-selection (anything-get-selection))
2283 (unless anything-saved-selection
2284 (error "Nothing is selected."))
2285 (setq anything-saved-current-source (anything-get-current-source))
2286 (let ((actions (anything-get-action)))
2287 (if (functionp actions)
2288 (message "Sole action: %s" actions)
2289 (anything-show-action-buffer actions)
2290 (anything-delete-minibuffer-contents)
2291 (setq anything-pattern 'dummy) ; so that it differs from the previous one
2292 (anything-check-minibuffer-input))))))
2294 (defun anything-show-action-buffer (actions)
2295 (with-current-buffer (get-buffer-create anything-action-buffer)
2296 (erase-buffer)
2297 (buffer-disable-undo)
2298 (set-window-buffer (get-buffer-window anything-buffer) anything-action-buffer)
2299 (set (make-local-variable 'anything-sources)
2300 `(((name . "Actions")
2301 (volatile)
2302 (candidates . ,actions)
2303 (candidate-number-limit))))
2304 (set (make-local-variable 'anything-source-filter) nil)
2305 (set (make-local-variable 'anything-selection-overlay) nil)
2306 (set (make-local-variable 'anything-digit-overlays) nil)
2307 (anything-initialize-overlays anything-action-buffer)))
2309 ;; (@* "Core: selection")
2310 (defun anything-move-selection-common (move-func unit direction)
2311 "Move the selection marker to a new position determined by
2312 UNIT and DIRECTION."
2313 (unless (or (anything-empty-buffer-p (anything-buffer-get))
2314 (not (anything-window)))
2315 (with-anything-window
2316 (funcall move-func)
2317 (anything-skip-noncandidate-line direction)
2318 (anything-display-source-at-screen-top-maybe unit)
2319 (when (anything-get-previous-header-pos)
2320 (anything-mark-current-line))
2321 (anything-display-mode-line (anything-get-current-source)))))
2323 (defun anything-display-source-at-screen-top-maybe (unit)
2324 (when (and anything-display-source-at-screen-top (eq unit 'source))
2325 (set-window-start (selected-window)
2326 (save-excursion (forward-line -1) (point)))))
2328 (defun anything-skip-noncandidate-line (direction)
2329 (anything-skip-header-and-separator-line direction)
2330 (and (bobp) (forward-line 1)) ;skip first header
2331 (and (eobp) (forward-line -1)) ;avoid last empty line
2334 (defun anything-skip-header-and-separator-line (direction)
2335 (while (and (not (bobp))
2336 (or (anything-pos-header-line-p)
2337 (anything-pos-candidate-separator-p)))
2338 (forward-line (if (and (eq direction 'previous)
2339 (not (eq (line-beginning-position) (point-min))))
2341 1))))
2343 (defvar anything-mode-line-string-real nil)
2344 (defun anything-display-mode-line (source)
2345 (set (make-local-variable 'anything-mode-line-string)
2346 (anything-interpret-value (or (assoc-default 'mode-line source)
2347 (default-value 'anything-mode-line-string))
2348 source))
2349 (if anything-mode-line-string
2350 (setq mode-line-format
2351 '(" " mode-line-buffer-identification " "
2352 (line-number-mode "%l") " " (anything-follow-mode "(F)")
2353 " " anything-mode-line-string-real "-%-")
2354 anything-mode-line-string-real
2355 (substitute-command-keys anything-mode-line-string))
2356 (setq mode-line-format
2357 (default-value 'mode-line-format)))
2358 (setq header-line-format
2359 (anything-interpret-value (assoc-default 'header-line source) source)))
2361 (defun anything-previous-line ()
2362 "Move selection to the previous line."
2363 (interactive)
2364 (anything-move-selection-common
2365 (lambda ()
2366 (if (not (anything-pos-multiline-p))
2367 (forward-line -1) ;double forward-line is meaningful
2368 (forward-line -1) ;because evaluation order is important
2369 (anything-skip-header-and-separator-line 'previous)
2370 (let ((header-pos (anything-get-previous-header-pos))
2371 (separator-pos (anything-get-previous-candidate-separator-pos)))
2372 (when header-pos
2373 (goto-char (if (or (null separator-pos) (< separator-pos header-pos)) ; first
2374 header-pos
2375 separator-pos))
2376 (forward-line 1)))))
2377 'line 'previous))
2379 (defun anything-next-line ()
2380 "Move selection to the next line."
2381 (interactive)
2382 (anything-move-selection-common
2383 (lambda ()
2384 (if (not (anything-pos-multiline-p))
2385 (forward-line 1)
2386 (let ((header-pos (anything-get-next-header-pos))
2387 (separator-pos (anything-get-next-candidate-separator-pos)))
2388 (cond ((and separator-pos
2389 (or (null header-pos) (< separator-pos header-pos)))
2390 (goto-char separator-pos))
2391 (header-pos
2392 (goto-char header-pos))))))
2393 'line 'next))
2395 (defun anything-previous-page ()
2396 "Move selection back with a pageful."
2397 (interactive)
2398 (anything-move-selection-common
2399 (lambda ()
2400 (condition-case nil
2401 (scroll-down)
2402 (beginning-of-buffer (goto-char (point-min)))))
2403 'page 'previous))
2405 (defun anything-next-page ()
2406 "Move selection forward with a pageful."
2407 (interactive)
2408 (anything-move-selection-common
2409 (lambda ()
2410 (condition-case nil
2411 (scroll-up)
2412 (end-of-buffer (goto-char (point-max)))))
2413 'page 'next))
2415 (defun anything-beginning-of-buffer ()
2416 "Move selection at the top."
2417 (interactive)
2418 (anything-move-selection-common (lambda () (goto-char (point-min)))
2419 'edge 'previous))
2421 (defun anything-end-of-buffer ()
2422 "Move selection at the bottom."
2423 (interactive)
2424 (anything-move-selection-common (lambda () (goto-char (point-max)))
2425 'edge 'next))
2427 (defun anything-previous-source ()
2428 "Move selection to the previous source."
2429 (interactive)
2430 (anything-move-selection-common
2431 (lambda ()
2432 (forward-line -1)
2433 (if (bobp)
2434 (goto-char (point-max))
2435 (anything-skip-header-and-separator-line 'previous))
2436 (goto-char (anything-get-previous-header-pos))
2437 (forward-line 1))
2438 'source 'previous))
2440 (defun anything-next-source ()
2441 "Move selection to the next source."
2442 (interactive)
2443 (anything-move-selection-common
2444 (lambda () (goto-char (or (anything-get-next-header-pos) (point-min))))
2445 'source 'next))
2447 (defun anything-goto-source (source-or-name)
2448 "Move the selection to the source (SOURCE-OR-NAME)."
2449 (anything-move-selection-common
2450 (lambda ()
2451 (goto-char (point-min))
2452 (let ((name (if (stringp source-or-name) source-or-name
2453 (assoc-default 'name source-or-name))))
2454 (while (not (string= name (anything-current-line-contents)))
2455 (goto-char (anything-get-next-header-pos)))))
2456 'source 'next))
2458 (defun anything-mark-current-line ()
2459 "Move selection overlay to current line."
2460 (move-overlay anything-selection-overlay
2461 (line-beginning-position)
2462 (if (anything-pos-multiline-p)
2463 (let ((header-pos (anything-get-next-header-pos))
2464 (separator-pos (anything-get-next-candidate-separator-pos)))
2465 (or (and (null header-pos) separator-pos separator-pos)
2466 (and header-pos separator-pos (< separator-pos header-pos) separator-pos)
2467 header-pos
2468 (point-max)))
2469 (1+ (line-end-position))))
2470 (anything-follow-execute-persistent-action-maybe))
2472 (defun anything-this-command-key ()
2473 (event-basic-type (elt (this-command-keys-vector) 0)))
2474 ;; (progn (read-key-sequence "Key: ") (p (anything-this-command-key)))
2476 (defun anything-select-with-shortcut-internal (types get-key-func)
2477 (if (memq anything-enable-shortcuts types)
2478 (save-selected-window
2479 (select-window (anything-window))
2480 (let* ((key (funcall get-key-func))
2481 (overlay (ignore-errors (nth (position key anything-shortcut-keys)
2482 anything-digit-overlays))))
2483 (if (not (and overlay (overlay-buffer overlay)))
2484 (when (numberp key)
2485 (select-window (minibuffer-window))
2486 (self-insert-command 1))
2487 (goto-char (overlay-start overlay))
2488 (anything-mark-current-line)
2489 (anything-exit-minibuffer))))
2490 (self-insert-command 1)))
2492 (defun anything-select-with-prefix-shortcut ()
2493 "Invoke default action with prefix shortcut."
2494 (interactive)
2495 (anything-select-with-shortcut-internal
2496 '(prefix)
2497 (lambda () (read-event "Select shortcut key: "))))
2499 (defun anything-select-with-digit-shortcut ()
2500 "Invoke default action with digit/alphabet shortcut."
2501 (interactive)
2502 (anything-select-with-shortcut-internal
2503 '(alphabet t) 'anything-this-command-key))
2505 ;; (setq anything-enable-shortcuts 'prefix)
2506 ;; (define-key anything-map "@" 'anything-select-with-prefix-shortcut)
2507 ;; (define-key anything-map (kbd "<f18>") 'anything-select-with-prefix-shortcut)
2509 (defun anything-exit-minibuffer ()
2510 "Select the current candidate by exiting the minibuffer."
2511 (interactive)
2512 (declare (special anything-iswitchb-candidate-selected))
2513 (setq anything-iswitchb-candidate-selected (anything-get-selection))
2514 (exit-minibuffer))
2517 (defun anything-get-next-header-pos ()
2518 "Return the position of the next header from point."
2519 (next-single-property-change (point) 'anything-header))
2522 (defun anything-get-previous-header-pos ()
2523 "Return the position of the previous header from point"
2524 (previous-single-property-change (point) 'anything-header))
2527 (defun anything-pos-multiline-p ()
2528 "Return non-nil if the current position is in the multiline source region."
2529 (get-text-property (point) 'anything-multiline))
2532 (defun anything-get-next-candidate-separator-pos ()
2533 "Return the position of the next candidate separator from point."
2534 (next-single-property-change (point) 'anything-candidate-separator))
2537 (defun anything-get-previous-candidate-separator-pos ()
2538 "Return the position of the previous candidate separator from point."
2539 (previous-single-property-change (point) 'anything-candidate-separator))
2542 (defun anything-pos-header-line-p ()
2543 "Return t if the current line is a header line."
2544 (or (get-text-property (line-beginning-position) 'anything-header)
2545 (get-text-property (line-beginning-position) 'anything-header-separator)))
2547 (defun anything-pos-candidate-separator-p ()
2548 "Return t if the current line is a candidate separator."
2549 (get-text-property (line-beginning-position) 'anything-candidate-separator))
2551 ;; (@* "Core: help")
2552 (defun anything-help-internal (bufname insert-content-fn)
2553 "Show long message during `anything' session."
2554 (save-window-excursion
2555 (select-window (anything-window))
2556 (delete-other-windows)
2557 (switch-to-buffer (get-buffer-create bufname))
2558 (erase-buffer)
2559 (funcall insert-content-fn)
2560 (setq mode-line-format "%b (SPC,C-v:NextPage b,M-v:PrevPage other:Exit)")
2561 (setq cursor-type nil)
2562 (goto-char 1)
2563 (anything-help-event-loop)))
2565 (defun anything-help-event-loop ()
2566 (ignore-errors
2567 (loop for event = (read-event) do
2568 (case event
2569 ((?\C-v ? ) (scroll-up))
2570 ((?\M-v ?b) (scroll-down))
2571 (t (return))))))
2573 (defun anything-help ()
2574 "Help of `anything'."
2575 (interactive)
2576 (anything-help-internal
2577 " *Anything Help*"
2578 (lambda ()
2579 (insert (substitute-command-keys
2580 (anything-interpret-value anything-help-message)))
2581 (org-mode))))
2583 (defun anything-debug-output ()
2584 "Show all anything-related variables at this time."
2585 (interactive)
2586 (anything-help-internal " *Anything Debug*" 'anything-debug-output-function))
2588 (defun anything-debug-output-function (&optional vars)
2589 (message "Calculating all anything-related values...")
2590 (insert "If you debug some variables or forms, set `anything-debug-forms'
2591 to a list of forms.\n\n")
2592 (dolist (v (or vars
2593 anything-debug-forms
2594 (apropos-internal "^anything-" 'boundp)))
2595 (insert "** "
2596 (pp-to-string v) "\n"
2597 (pp-to-string (eval v)) "\n"))
2598 (message "Calculating all anything-related values...Done"))
2600 ;; (@* "Core: misc")
2601 (defun anything-kill-buffer-hook ()
2602 "Remove tick entry from `anything-tick-hash' when killing a buffer."
2603 (loop for key being the hash-keys in anything-tick-hash
2604 if (string-match (format "^%s/" (regexp-quote (buffer-name))) key)
2605 do (remhash key anything-tick-hash)))
2606 (add-hook 'kill-buffer-hook 'anything-kill-buffer-hook)
2608 (defun anything-maybe-fit-frame ()
2609 "Fit anything frame to its buffer, and put it at top right of display.
2611 It is disabled by default because some flickering occurred in some environment.
2612 To enable fitting, set both `anything-inhibit-fit-frame-flag' and
2613 `fit-frame-inhibit-fitting' to nil.
2614 You can set user options `fit-frame-max-width-percent' and
2615 `fit-frame-max-height-percent' to control max frame size."
2616 (declare (warn (unresolved 0)))
2617 (when (and (require 'fit-frame nil t)
2618 (boundp 'fit-frame-inhibit-fitting-flag)
2619 (not anything-inhibit-fit-frame-flag)
2620 (not fit-frame-inhibit-fitting-flag)
2621 (anything-window))
2622 (ignore-errors
2623 (with-anything-window
2624 (fit-frame nil nil nil t)
2625 (modify-frame-parameters
2626 (selected-frame)
2627 `((left . ,(- (x-display-pixel-width) (+ (frame-pixel-width) 7)))
2628 (top . 0))))))) ; The (top . 0) shouldn't be necessary (Emacs bug).
2630 (defun anything-preselect (candidate-or-regexp)
2631 (with-anything-window
2632 (when candidate-or-regexp
2633 (goto-char (point-min))
2634 ;; go to first candidate of first source
2635 (forward-line 1)
2636 (let ((start (point)))
2637 (unless (or (re-search-forward (concat "^" (regexp-quote candidate-or-regexp) "$") nil t)
2638 (progn (goto-char start)
2639 (re-search-forward candidate-or-regexp nil t)))
2640 (goto-char start))))
2641 (anything-mark-current-line)))
2643 (defun anything-delete-current-selection ()
2644 "Delete the currently selected item."
2645 (interactive)
2646 (with-anything-window
2647 (cond ((anything-pos-multiline-p)
2648 (anything-aif (anything-get-next-candidate-separator-pos)
2649 (delete-region (point-at-bol)
2650 (1+ (progn (goto-char it) (point-at-eol))))
2651 ;; last candidate
2652 (goto-char (anything-get-previous-candidate-separator-pos))
2653 (delete-region (point-at-bol) (point-max)))
2654 (when (eobp)
2655 (goto-char (or (anything-get-previous-candidate-separator-pos)
2656 (point-min)))
2657 (forward-line 1)))
2659 (delete-region (point-at-bol) (1+ (point-at-eol)))
2660 (when (eobp) (forward-line -1))))
2661 (anything-mark-current-line)))
2663 (defun anything-edit-current-selection-internal (func)
2664 (with-anything-window
2665 (beginning-of-line)
2666 (let ((realvalue (get-text-property (point) 'anything-realvalue)))
2667 (funcall func)
2668 (beginning-of-line)
2669 (and realvalue
2670 (put-text-property (point) (point-at-eol) 'anything-realvalue realvalue))
2671 (anything-mark-current-line))))
2673 (defmacro anything-edit-current-selection (&rest forms)
2674 "Evaluate FORMS at current selection in the anything buffer.
2675 You can edit the line."
2676 `(anything-edit-current-selection-internal
2677 (lambda () ,@forms)))
2678 (put 'anything-edit-current-selection 'lisp-indent-function 0)
2680 (defun anything-set-pattern (pattern)
2681 "Set minibuffer contents to PATTERN."
2682 (with-selected-window (minibuffer-window)
2683 (delete-minibuffer-contents)
2684 (insert pattern)))
2686 (defun anything-delete-minibuffer-contents ()
2687 "Same as `delete-minibuffer-contents' but this is a command."
2688 (interactive)
2689 (anything-set-pattern ""))
2690 (defalias 'anything-delete-minibuffer-content 'anything-delete-minibuffer-contents)
2692 ;; (@* "Built-in plug-in: type")
2693 (defun anything-compile-source--type (source)
2694 (anything-aif (assoc-default 'type source)
2695 (append source (assoc-default it anything-type-attributes) nil)
2696 source))
2698 ;; `define-anything-type-attribute' is public API.
2700 (defun anything-add-type-attribute (type definition)
2701 (anything-aif (assq type anything-type-attributes)
2702 (setq anything-type-attributes (delete it anything-type-attributes)))
2703 (push (cons type definition) anything-type-attributes))
2705 (defvar anything-types nil)
2706 (defun anything-document-type-attribute (type doc)
2707 (add-to-list 'anything-types type t)
2708 (put type 'anything-typeattrdoc
2709 (concat "- " (symbol-name type) "\n\n" doc "\n")))
2711 (defadvice documentation-property (after anything-document-type-attribute activate)
2712 "Hack to display type attributes' documentation as `anything-type-attributes' docstring."
2713 (when (eq symbol 'anything-type-attributes)
2714 (setq ad-return-value
2715 (concat ad-return-value "\n\n++++ Types currently defined ++++\n"
2716 (mapconcat (lambda (sym) (get sym 'anything-typeattrdoc))
2717 anything-types "\n")))))
2719 ;; (@* "Built-in plug-in: dummy")
2720 (defun anything-dummy-candidate (candidate source)
2721 ;; `source' is defined in filtered-candidate-transformer
2722 (list anything-pattern))
2724 (defun anything-compile-source--dummy (source)
2725 (if (assoc 'dummy source)
2726 (append source
2727 '((candidates "dummy")
2728 (accept-empty)
2729 (match identity)
2730 (filtered-candidate-transformer . anything-dummy-candidate)
2731 (disable-shortcuts)
2732 (volatile)))
2733 source))
2735 ;; (@* "Built-in plug-in: disable-shortcuts")
2736 (defvar anything-orig-enable-shortcuts nil)
2737 (defun anything-save-enable-shortcuts ()
2738 (anything-once
2739 (lambda () (setq anything-orig-enable-shortcuts anything-enable-shortcuts
2740 anything-enable-shortcuts nil))))
2741 (defun anything-compile-source--disable-shortcuts (source)
2742 (if (assoc 'disable-shortcuts source)
2743 (append `((init ,@(anything-mklist (assoc-default 'init source))
2744 anything-save-enable-shortcuts)
2745 (resume ,@(anything-mklist (assoc-default 'resume source))
2746 anything-save-enable-shortcuts)
2747 (cleanup ,@(anything-mklist (assoc-default 'cleanup source))
2748 (lambda () (setq anything-enable-shortcuts anything-orig-enable-shortcuts))))
2749 source)
2750 source))
2752 ;; (@* "Built-in plug-in: candidates-in-buffer")
2753 (defun anything-candidates-in-buffer ()
2754 "Get candidates from the candidates buffer according to `anything-pattern'.
2756 BUFFER is `anything-candidate-buffer' by default. Each
2757 candidate must be placed in one line. This function is meant to
2758 be used in candidates-in-buffer or candidates attribute of an
2759 anything source. Especially fast for many (1000+) candidates.
2762 '((name . \"many files\")
2763 (init . (lambda () (with-current-buffer (anything-candidate-buffer 'local)
2764 (insert-many-filenames))))
2765 (search re-search-forward) ; optional
2766 (candidates-in-buffer)
2767 (type . file))
2769 +===============================================================+
2770 | The new way of making and narrowing candidates: Using buffers |
2771 +===============================================================+
2773 By default, `anything' makes candidates by evaluating the
2774 candidates function, then narrows them by `string-match' for each
2775 candidate.
2777 But this way is very slow for many candidates. The new way is
2778 storing all candidates in a buffer and narrowing them by
2779 `re-search-forward'. Search function is customizable by search
2780 attribute. The important point is that buffer processing is MUCH
2781 FASTER than string list processing and is the Emacs way.
2783 The init function writes all candidates to a newly-created
2784 candidate buffer. The candidates buffer is created or specified
2785 by `anything-candidate-buffer'. Candidates are stored in a line.
2787 The candidates function narrows all candidates, IOW creates a
2788 subset of candidates dynamically. It is the task of
2789 `anything-candidates-in-buffer'. As long as
2790 `anything-candidate-buffer' is used,`(candidates-in-buffer)' is
2791 sufficient in most cases.
2793 Note that `(candidates-in-buffer)' is shortcut of three attributes:
2794 (candidates . anything-candidates-in-buffer)
2795 (volatile)
2796 (match identity)
2797 And `(candidates-in-buffer . func)' is shortcut of three attributes:
2798 (candidates . func)
2799 (volatile)
2800 (match identity)
2801 The expansion is performed in `anything-get-sources'.
2803 The candidates-in-buffer attribute implies the volatile attribute.
2804 The volatile attribute is needed because `anything-candidates-in-buffer'
2805 creates candidates dynamically and need to be called everytime
2806 `anything-pattern' changes.
2808 Because `anything-candidates-in-buffer' plays the role of `match' attribute
2809 function, specifying `(match identity)' makes the source slightly faster.
2811 To customize `anything-candidates-in-buffer' behavior, use search,
2812 get-line and search-from-end attributes. See also `anything-sources' docstring.
2814 (declare (special source))
2815 (anything-candidates-in-buffer-1 (anything-candidate-buffer)
2816 anything-pattern
2817 (or (assoc-default 'get-line source)
2818 #'buffer-substring-no-properties)
2819 ;; use external variable `source'.
2820 (or (assoc-default 'search source)
2821 (if (assoc 'search-from-end source)
2822 '(re-search-backward)
2823 '(re-search-forward)))
2824 (anything-candidate-number-limit source)
2825 (assoc 'search-from-end source)))
2827 (defun anything-candidates-in-buffer-1 (buffer pattern get-line-fn search-fns limit search-from-end)
2828 ;; buffer == nil when candidates buffer does not exist.
2829 (when buffer
2830 (with-current-buffer buffer
2831 (let ((start-point (if search-from-end (point-max) (point-min)))
2832 (endp (if search-from-end #'bobp #'eobp)))
2833 (goto-char (1- start-point))
2834 (if (string= pattern "")
2835 (anything-initial-candidates-from-candidate-buffer
2836 endp get-line-fn limit search-from-end)
2837 (anything-search-from-candidate-buffer
2838 pattern get-line-fn search-fns limit search-from-end start-point endp))))))
2840 (defun anything-search-from-candidate-buffer (pattern get-line-fn search-fns limit search-from-end start-point endp)
2841 (let (buffer-read-only
2842 matches exit newmatches)
2843 (anything-search-from-candidate-buffer-internal
2844 (lambda ()
2845 (clrhash anything-cib-hash)
2846 (dolist (searcher search-fns)
2847 (goto-char start-point)
2848 (setq newmatches nil)
2849 (loop with item-count = 0
2850 with next-line-fn =
2851 (if search-from-end
2852 (lambda (x) (goto-char (max (point-at-bol) 1)))
2853 #'forward-line)
2854 while (funcall searcher pattern nil t)
2855 for cand = (funcall get-line-fn (point-at-bol) (point-at-eol))
2857 (anything-accumulate-candidates-internal cand newmatches anything-cib-hash item-count limit)
2858 (funcall next-line-fn 1))
2859 (setq matches (append matches (nreverse newmatches)))
2860 (if exit (return)))
2861 (delq nil matches)))))
2863 (defun anything-initial-candidates-from-candidate-buffer (endp get-line-fn limit search-from-end)
2864 (delq nil (loop with next-line-fn =
2865 (if search-from-end
2866 (lambda (x) (goto-char (max (1- (point-at-bol)) 1)))
2867 #'forward-line)
2868 until (funcall endp)
2869 for i from 1 to limit
2870 collect (funcall get-line-fn (point-at-bol) (point-at-eol))
2871 do (funcall next-line-fn 1))))
2873 (defun anything-search-from-candidate-buffer-internal (search-fn)
2874 (goto-char (point-min))
2875 (insert "\n")
2876 (goto-char (point-max))
2877 (insert "\n")
2878 (unwind-protect
2879 (funcall search-fn)
2880 (goto-char (point-min))
2881 (delete-char 1)
2882 (goto-char (1- (point-max)))
2883 (delete-char 1)
2885 (set-buffer-modified-p nil)))
2887 (defun anything-candidate-buffer (&optional create-or-buffer)
2888 "Register and return a buffer containing candidates of current source.
2889 `anything-candidate-buffer' searches buffer-local candidates buffer first,
2890 then global candidates buffer.
2892 Acceptable values of CREATE-OR-BUFFER:
2894 - nil (omit)
2895 Only return the candidates buffer.
2896 - a buffer
2897 Register a buffer as a candidates buffer.
2898 - 'global
2899 Create a new global candidates buffer,
2900 named \" *anything candidates:SOURCE*\".
2901 - other non-nil value
2902 Create a new local candidates buffer,
2903 named \" *anything candidates:SOURCE*ANYTHING-CURRENT-BUFFER\".
2905 (let* ((global-bname (format " *anything candidates:%s*" anything-source-name))
2906 (local-bname (format " *anything candidates:%s*%s"
2907 anything-source-name
2908 (buffer-name anything-current-buffer)))
2909 (register-func
2910 (lambda ()
2911 (setq anything-candidate-buffer-alist
2912 (cons (cons anything-source-name create-or-buffer)
2913 (delete (assoc anything-source-name
2914 anything-candidate-buffer-alist)
2915 anything-candidate-buffer-alist)))))
2916 (kill-buffers-func
2917 (lambda ()
2918 (loop for b in (buffer-list)
2919 if (string-match (format "^%s" (regexp-quote global-bname))
2920 (buffer-name b))
2921 do (kill-buffer b))))
2922 (create-func
2923 (lambda ()
2924 (with-current-buffer
2925 (get-buffer-create (if (eq create-or-buffer 'global)
2926 global-bname
2927 local-bname))
2928 (buffer-disable-undo)
2929 (erase-buffer)
2930 (font-lock-mode -1))))
2931 (return-func
2932 (lambda ()
2933 (or (get-buffer local-bname)
2934 (get-buffer global-bname)
2935 (anything-aif (assoc-default anything-source-name
2936 anything-candidate-buffer-alist)
2937 (and (buffer-live-p it) it))))))
2938 (when create-or-buffer
2939 (funcall register-func)
2940 (unless (bufferp create-or-buffer)
2941 (and (eq create-or-buffer 'global) (funcall kill-buffers-func))
2942 (funcall create-func)))
2943 (funcall return-func)))
2945 (defun anything-compile-source--candidates-in-buffer (source)
2946 (anything-aif (assoc 'candidates-in-buffer source)
2947 (append source `((candidates . ,(or (cdr it) 'anything-candidates-in-buffer))
2948 (volatile) (match identity)))
2949 source))
2951 ;; (@* "Utility: resplit anything window")
2952 (defun anything-toggle-resplit-window ()
2953 "Toggle resplit anything window, vertically or horizontally."
2954 (interactive)
2955 (with-anything-window
2956 (let ((before-height (window-height)))
2957 (delete-window)
2958 (set-window-buffer
2959 (select-window (if (= (window-height) before-height)
2960 (split-window-vertically)
2961 (split-window-horizontally)))
2962 anything-buffer))))
2964 ;; (@* "Utility: select another action by key")
2965 (defun anything-select-nth-action (n)
2966 "Select the nth action for the currently selected candidate."
2967 (setq anything-saved-selection (anything-get-selection))
2968 (unless anything-saved-selection
2969 (error "Nothing is selected."))
2970 (setq anything-saved-action (cdr (elt (anything-get-action) n)))
2971 (anything-exit-minibuffer))
2973 (defun anything-select-2nd-action ()
2974 "Select the 2nd action for the currently selected candidate."
2975 (interactive)
2976 (anything-select-nth-action 1))
2978 (defun anything-select-3rd-action ()
2979 "Select the 3rd action for the currently selected candidate."
2980 (interactive)
2981 (anything-select-nth-action 2))
2983 (defun anything-select-4th-action ()
2984 "Select the 4th action for the currently selected candidate."
2985 (interactive)
2986 (anything-select-nth-action 3))
2988 (defun anything-select-2nd-action-or-end-of-line ()
2989 "Select the 2nd action for the currently selected candidate if the point is at the end of minibuffer.
2990 Otherwise goto the end of minibuffer."
2991 (interactive)
2992 (if (eolp)
2993 (anything-select-nth-action 1)
2994 (end-of-line)))
2996 ;; (@* "Utility: Persistent Action")
2997 (defmacro with-anything-display-same-window (&rest body)
2998 "Make `pop-to-buffer' and `display-buffer' display in the same window."
2999 `(let ((display-buffer-function 'anything-persistent-action-display-buffer))
3000 ,@body))
3001 (put 'with-anything-display-same-window 'lisp-indent-function 0)
3003 (defun* anything-execute-persistent-action (&optional (attr 'persistent-action))
3004 "If a candidate is selected then perform the associated action without quitting anything."
3005 (interactive)
3006 (anything-log "executing persistent-action")
3007 (save-selected-window
3008 (select-window (get-buffer-window (anything-buffer-get)))
3009 (select-window (setq minibuffer-scroll-window
3010 (if (one-window-p t) (split-window)
3011 (next-window (selected-window) 1))))
3012 (anything-log-eval (current-buffer))
3013 (let ((anything-in-persistent-action t))
3014 (with-anything-display-same-window
3015 (anything-execute-selection-action
3017 (or (assoc-default attr (anything-get-current-source))
3018 (anything-get-action))
3020 (anything-log-run-hook 'anything-after-persistent-action-hook)))))
3022 (defun anything-persistent-action-display-buffer (buf &optional not-this-window)
3023 "Make `pop-to-buffer' and `display-buffer' display in the same window in persistent action.
3024 If `anything-persistent-action-use-special-display' is non-nil and
3025 BUF is to be displayed by `special-display-function', use it.
3026 Otherwise ignores `special-display-buffer-names' and `special-display-regexps'."
3027 (let* ((name (buffer-name buf))
3028 display-buffer-function pop-up-windows
3029 (same-window-regexps
3030 (unless (and anything-persistent-action-use-special-display
3031 (or (member name
3032 (mapcar (lambda (x) (or (car-safe x) x))
3033 special-display-buffer-names))
3034 (remove-if-not
3035 (lambda (x) (string-match (or (car-safe x) x) name))
3036 special-display-regexps)))
3037 '("."))))
3038 (display-buffer buf not-this-window)))
3040 ;; scroll-other-window(-down)? for persistent-action
3041 (defun anything-scroll-other-window-base (command)
3042 (save-selected-window
3043 (select-window
3044 (some-window
3045 (lambda (w) (not (string= anything-buffer (buffer-name (window-buffer w)))))
3046 'no-minibuffer 'current-frame))
3047 (funcall command anything-scroll-amount)))
3049 (defun anything-scroll-other-window ()
3050 "Scroll other window (not *Anything* window) upward."
3051 (interactive)
3052 (anything-scroll-other-window-base 'scroll-up))
3053 (defun anything-scroll-other-window-down ()
3054 "Scroll other window (not *Anything* window) downward."
3055 (interactive)
3056 (anything-scroll-other-window-base 'scroll-down))
3058 ;; (@* "Utility: Visible Mark")
3059 (defface anything-visible-mark
3060 '((((min-colors 88) (background dark))
3061 (:background "green1" :foreground "black"))
3062 (((background dark)) (:background "green" :foreground "black"))
3063 (((min-colors 88)) (:background "green1"))
3064 (t (:background "green")))
3065 "Face for visible mark."
3066 :group 'anything)
3067 (defvar anything-visible-mark-face 'anything-visible-mark)
3068 (defvar anything-visible-mark-overlays nil)
3070 (defun anything-clear-visible-mark ()
3071 (with-current-buffer (anything-buffer-get)
3072 (mapc 'delete-overlay anything-visible-mark-overlays)
3073 (set (make-local-variable 'anything-visible-mark-overlays)
3074 nil)))
3075 (add-hook 'anything-after-initialize-hook 'anything-clear-visible-mark)
3077 (defvar anything-c-marked-candidate-list nil
3078 "[OBSOLETE] DO NOT USE!!")
3079 (defvar anything-marked-candidates nil
3080 "Marked candadates. List of (source . real) pair.")
3081 (defun anything-toggle-visible-mark ()
3082 (interactive)
3083 (with-anything-window
3084 (let ((display (anything-current-line-contents))
3085 (source (anything-get-current-source))
3086 (selection (anything-get-selection)))
3087 (anything-aif (loop for o in anything-visible-mark-overlays
3088 when (equal (line-beginning-position) (overlay-start o))
3089 do (return o))
3090 ;; delete
3091 (progn
3092 (setq anything-c-marked-candidate-list
3093 (remove
3094 display anything-c-marked-candidate-list))
3095 (setq anything-marked-candidates
3096 (remove
3097 (cons source selection)
3098 anything-marked-candidates))
3099 (delete-overlay it)
3100 (setq anything-visible-mark-overlays (delq it anything-visible-mark-overlays)))
3101 (let ((o (make-overlay (line-beginning-position) (1+ (line-end-position)))))
3102 (overlay-put o 'face anything-visible-mark-face)
3103 (overlay-put o 'source (assoc-default 'name source))
3104 (overlay-put o 'string (buffer-substring (overlay-start o) (overlay-end o)))
3105 (add-to-list 'anything-visible-mark-overlays o)
3106 (push display anything-c-marked-candidate-list)
3107 (push (cons source selection) anything-marked-candidates)))
3108 (anything-next-line))))
3110 (defun anything-display-all-visible-marks ()
3111 "Show all `anything' visible marks strings."
3112 (interactive)
3113 (lexical-let ((overlays (reverse anything-visible-mark-overlays)))
3114 (anything-run-after-quit
3115 (lambda ()
3116 (with-output-to-temp-buffer "*anything visible marks*"
3117 (dolist (o overlays) (princ (overlay-get o 'string))))))))
3119 (defun anything-marked-candidates ()
3120 "Marked candidates (real value) of current source if any,
3121 otherwise 1-element list of current selection.
3123 It is analogous to `dired-get-marked-files'."
3124 (with-current-buffer (anything-buffer-get)
3125 (let ((cands (if anything-marked-candidates
3126 (loop with current-src = (anything-get-current-source)
3127 for (source . real) in (reverse anything-marked-candidates)
3128 when (equal current-src source)
3129 collect real)
3130 (list (anything-get-selection)))))
3131 (anything-log-eval cands)
3132 cands)))
3134 (defun anything-reset-marked-candidates ()
3135 (with-current-buffer (anything-buffer-get)
3136 (set (make-local-variable 'anything-c-marked-candidate-list) nil)
3137 (set (make-local-variable 'anything-marked-candidates) nil)))
3139 (add-hook 'anything-after-initialize-hook 'anything-reset-marked-candidates)
3140 ;; (add-hook 'anything-after-action-hook 'anything-reset-marked-candidates)
3142 (defun anything-revive-visible-mark ()
3143 (interactive)
3144 (with-current-buffer anything-buffer
3145 (loop for o in anything-visible-mark-overlays do
3146 (goto-char (point-min))
3147 (let (moved)
3148 (while (and (not moved)
3149 (search-forward (overlay-get o 'string) nil t))
3150 (forward-line -1)
3151 (when (and (save-excursion
3152 (goto-char (anything-get-previous-header-pos))
3153 (equal (overlay-get o 'source)
3154 (anything-current-line-contents)))
3155 (not (find-if (lambda (x)
3156 (memq x anything-visible-mark-overlays))
3157 (overlays-at (point)))))
3158 (move-overlay o (line-beginning-position) (1+ (line-end-position)))
3159 (setq moved t))
3160 (forward-line 1))))))
3161 (add-hook 'anything-update-hook 'anything-revive-visible-mark)
3163 (defun anything-next-visible-mark (&optional prev)
3164 (interactive)
3165 (with-anything-window
3166 (block 'exit
3167 (setq anything-visible-mark-overlays
3168 (sort* anything-visible-mark-overlays
3169 '< :key 'overlay-start))
3170 (let ((i (position-if (lambda (o) (< (point) (overlay-start o)))
3171 anything-visible-mark-overlays)))
3172 (when prev
3173 (unless anything-visible-mark-overlays (return-from 'exit nil))
3174 (if (not i) (setq i (length anything-visible-mark-overlays)))
3175 (if (equal (point) (overlay-start (nth (1- i) anything-visible-mark-overlays)))
3176 (setq i (1- i))))
3177 (when i
3178 (goto-char (overlay-start (nth (if prev (1- i) i) anything-visible-mark-overlays)))
3179 (anything-mark-current-line))))))
3181 (defun anything-prev-visible-mark ()
3182 (interactive)
3183 (anything-next-visible-mark t))
3185 ;; (@* "Utility: `find-file' integration")
3186 (defun anything-quit-and-find-file ()
3187 "Drop into `find-file' from `anything' like `iswitchb-find-file'.
3188 If current selection is a buffer or a file, `find-file' from its directory."
3189 (interactive)
3190 (anything-run-after-quit
3191 (lambda (f)
3192 (if (file-exists-p f)
3193 (let ((default-directory (file-name-directory f)))
3194 (call-interactively 'find-file))
3195 (call-interactively 'find-file)))
3196 (anything-aif (get-buffer (anything-get-selection))
3197 (buffer-file-name it)
3198 (expand-file-name (anything-get-selection)))))
3200 ;; (@* "Utility: Selection Paste")
3201 (defun anything-yank-selection ()
3202 "Set minibuffer contents to current selection."
3203 (interactive)
3204 (anything-set-pattern (anything-get-selection nil t)))
3206 (defun anything-kill-selection-and-quit ()
3207 "Store current selection to kill ring.
3208 You can paste it by typing C-y."
3209 (interactive)
3210 (anything-run-after-quit
3211 (lambda (sel)
3212 (kill-new sel)
3213 (message "Killed: %s" sel))
3214 (anything-get-selection nil t)))
3217 ;; (@* "Utility: Automatical execution of persistent-action")
3218 (add-to-list 'minor-mode-alist '(anything-follow-mode " AFollow"))
3219 (defun anything-follow-mode ()
3220 "If this mode is on, persistent action is executed everytime the cursor is moved."
3221 (interactive)
3222 (with-current-buffer anything-buffer
3223 (setq anything-follow-mode (not anything-follow-mode))
3224 (message "anything-follow-mode is %s"
3225 (if anything-follow-mode "enabled" "disabled"))))
3227 (defun anything-follow-execute-persistent-action-maybe ()
3228 "Execute persistent action after `anything-input-idle-delay' secs when `anything-follow-mode' is enabled."
3229 (and (buffer-local-value 'anything-follow-mode
3230 (get-buffer-create anything-buffer))
3231 (sit-for anything-input-idle-delay)
3232 (anything-window)
3233 (anything-get-selection)
3234 (save-excursion
3235 (anything-execute-persistent-action))))
3237 ;; (@* "Utility: Migrate `anything-sources' to my-anything command")
3238 (defun anything-migrate-sources ()
3239 "Help to migrate to new `anything' way."
3240 (interactive)
3241 (with-current-buffer (get-buffer-create "*anything migrate*")
3242 (erase-buffer)
3243 (insert (format "\
3244 Setting `anything-sources' directly is not good because
3245 `anything' is not for one command. For now, interactive use of
3246 `anything' (M-x anything) is only for demonstration purpose.
3247 So you should define commands calling `anything'.
3248 I help you to migrate to the new way.
3250 The code below is automatically generated from current
3251 `anything-sources' value. You can use the `my-anything' command
3252 now!
3254 Copy and paste it to your .emacs. Then substitute `my-anything'
3255 for `anything' bindings in all `define-key', `local-set-key' and
3256 `global-set-key' calls.
3258 \(defun my-anything ()
3259 \"Anything command for you.
3261 It is automatically generated by `anything-migrate-sources'.\"
3262 (interactive)
3263 (anything-other-buffer
3265 \"*my-anything*\"))
3266 " anything-sources))
3267 (eval-last-sexp nil)
3268 (substitute-key-definition 'anything 'my-anything global-map)
3269 (pop-to-buffer (current-buffer))))
3271 ;; (@* "Utility: Incremental search within results (unmaintained)")
3273 (defvar anything-isearch-original-global-map nil
3274 "Original global map before Anything isearch is started.")
3276 (defvar anything-isearch-original-message-timeout nil
3277 "Original message timeout before Anything isearch is started.")
3279 (defvar anything-isearch-pattern nil
3280 "The current isearch pattern.")
3282 (defvar anything-isearch-message-suffix ""
3283 "Message suffix indicating the current state of the search.")
3285 (defvar anything-isearch-original-point nil
3286 "Original position of point before isearch is started.")
3288 (defvar anything-isearch-original-window nil
3289 "Original selected window before isearch is started.")
3291 (defvar anything-isearch-original-cursor-in-non-selected-windows nil
3292 "Original value of cursor-in-non-selected-windows before isearch is started.")
3294 (defvar anything-isearch-original-deferred-action-list nil
3295 "Original value of deferred-action-list before isearch is started.")
3297 (defvar anything-isearch-match-positions nil
3298 "Stack of positions of matches or non-matches.
3300 It's a list of plists with two properties: `event', the last user
3301 event, `start', the start position of the current match, and
3302 `pos', the position of point after that event.
3304 The value of `event' can be the following symbols: `char' if a
3305 character was typed, `error' if a non-matching character was
3306 typed, `search' if a forward search had to be done after a
3307 character, and `search-again' if a search was done for the next
3308 occurrence of the current pattern.")
3310 (defvar anything-isearch-match-start nil
3311 "Start position of the current match.")
3314 (defun anything-isearch ()
3315 "Start incremental search within results. (UNMAINTAINED)"
3316 (interactive)
3317 (if (anything-empty-buffer-p (anything-buffer-get))
3318 (message "There are no results.")
3320 (setq anything-isearch-original-message-timeout minibuffer-message-timeout)
3321 (setq minibuffer-message-timeout nil)
3323 (setq anything-isearch-original-global-map global-map)
3325 (condition-case nil
3326 (progn
3327 (setq anything-isearch-original-window (selected-window))
3328 (select-window (anything-window))
3329 (setq cursor-type t)
3331 (setq anything-isearch-original-deferred-action-list
3332 (default-value 'deferred-action-list))
3333 (setq-default deferred-action-list nil)
3334 (add-hook 'deferred-action-list 'anything-isearch-post-command)
3336 (use-global-map anything-isearch-map)
3337 (setq overriding-terminal-local-map anything-isearch-map)
3339 (setq anything-isearch-pattern "")
3341 (setq anything-isearch-original-cursor-in-non-selected-windows
3342 cursor-in-non-selected-windows)
3343 (setq cursor-in-non-selected-windows nil)
3345 (setq anything-isearch-original-point (point-marker))
3346 (goto-char (point-min))
3347 (forward-line)
3348 (anything-mark-current-line)
3350 (setq anything-isearch-match-positions nil)
3351 (setq anything-isearch-match-start (point-marker))
3353 (if anything-isearch-overlay
3354 ;; make sure the overlay belongs to the anything buffer
3355 (move-overlay anything-isearch-overlay (point-min) (point-min)
3356 (get-buffer (anything-buffer-get)))
3358 (setq anything-isearch-overlay (make-overlay (point-min) (point-min)))
3359 (overlay-put anything-isearch-overlay 'face anything-isearch-match-face))
3361 (setq anything-isearch-message-suffix
3362 (substitute-command-keys "cancel with \\[anything-isearch-cancel]")))
3364 (error (anything-isearch-cleanup)))))
3367 (defun anything-isearch-post-command ()
3368 "Print the current pattern after every command."
3369 (anything-isearch-message)
3370 (when (anything-window)
3371 (with-anything-window
3372 (move-overlay anything-isearch-overlay anything-isearch-match-start (point)
3373 (get-buffer (anything-buffer-get))))))
3376 (defun anything-isearch-printing-char ()
3377 "Add printing char to the pattern."
3378 (interactive)
3379 (let ((char (char-to-string last-command-event)))
3380 (setq anything-isearch-pattern (concat anything-isearch-pattern char))
3382 (with-anything-window
3383 (if (looking-at char)
3384 (progn
3385 (push (list 'event 'char
3386 'start anything-isearch-match-start
3387 'pos (point-marker))
3388 anything-isearch-match-positions)
3389 (forward-char))
3391 (let ((start (point)))
3392 (while (and (re-search-forward anything-isearch-pattern nil t)
3393 (anything-pos-header-line-p)))
3394 (if (or (anything-pos-header-line-p)
3395 (eq start (point)))
3396 (progn
3397 (goto-char start)
3398 (push (list 'event 'error
3399 'start anything-isearch-match-start
3400 'pos (point-marker))
3401 anything-isearch-match-positions))
3403 (push (list 'event 'search
3404 'start anything-isearch-match-start
3405 'pos (copy-marker start))
3406 anything-isearch-match-positions)
3407 (setq anything-isearch-match-start (copy-marker (match-beginning 0))))))
3409 (anything-mark-current-line))))
3412 (defun anything-isearch-again ()
3413 "Search again for the current pattern"
3414 (interactive)
3415 (if (equal anything-isearch-pattern "")
3416 (setq anything-isearch-message-suffix "no pattern yet")
3418 (with-anything-window
3419 (let ((start (point)))
3420 (while (and (re-search-forward anything-isearch-pattern nil t)
3421 (anything-pos-header-line-p)))
3422 (if (or (anything-pos-header-line-p)
3423 (eq start (point)))
3424 (progn
3425 (goto-char start)
3426 (unless (eq 'error (plist-get (car anything-isearch-match-positions)
3427 'event))
3428 (setq anything-isearch-message-suffix "no more matches")))
3430 (push (list 'event 'search-again
3431 'start anything-isearch-match-start
3432 'pos (copy-marker start))
3433 anything-isearch-match-positions)
3434 (setq anything-isearch-match-start (copy-marker (match-beginning 0)))
3436 (anything-mark-current-line))))))
3439 (defun anything-isearch-delete ()
3440 "Undo last event."
3441 (interactive)
3442 (unless (equal anything-isearch-pattern "")
3443 (let ((last (pop anything-isearch-match-positions)))
3444 (unless (eq 'search-again (plist-get last 'event))
3445 (setq anything-isearch-pattern
3446 (substring anything-isearch-pattern 0 -1)))
3448 (with-anything-window
3449 (goto-char (plist-get last 'pos))
3450 (setq anything-isearch-match-start (plist-get last 'start))
3451 (anything-mark-current-line)))))
3454 (defun anything-isearch-default-action ()
3455 "Execute the default action for the selected candidate."
3456 (interactive)
3457 (anything-isearch-cleanup)
3458 (with-current-buffer (anything-buffer-get) (anything-exit-minibuffer)))
3461 (defun anything-isearch-select-action ()
3462 "Choose an action for the selected candidate."
3463 (interactive)
3464 (anything-isearch-cleanup)
3465 (with-anything-window
3466 (anything-select-action)))
3469 (defun anything-isearch-cancel ()
3470 "Cancel Anything isearch."
3471 (interactive)
3472 (anything-isearch-cleanup)
3473 (when (anything-window)
3474 (with-anything-window
3475 (goto-char anything-isearch-original-point)
3476 (anything-mark-current-line))))
3479 (defun anything-isearch-cleanup ()
3480 "Clean up the mess."
3481 (setq minibuffer-message-timeout anything-isearch-original-message-timeout)
3482 (with-current-buffer (anything-buffer-get)
3483 (setq overriding-terminal-local-map nil)
3484 (setq cursor-type nil)
3485 (setq cursor-in-non-selected-windows
3486 anything-isearch-original-cursor-in-non-selected-windows))
3487 (when anything-isearch-original-window
3488 (select-window anything-isearch-original-window))
3490 (use-global-map anything-isearch-original-global-map)
3491 (setq-default deferred-action-list anything-isearch-original-deferred-action-list)
3492 (when (overlayp anything-isearch-overlay)
3493 (delete-overlay anything-isearch-overlay)))
3496 (defun anything-isearch-message ()
3497 "Print prompt."
3498 (if (and (equal anything-isearch-message-suffix "")
3499 (eq (plist-get (car anything-isearch-match-positions) 'event)
3500 'error))
3501 (setq anything-isearch-message-suffix "failing"))
3503 (unless (equal anything-isearch-message-suffix "")
3504 (setq anything-isearch-message-suffix
3505 (concat " [" anything-isearch-message-suffix "]")))
3507 (message (concat "Search within results: "
3508 anything-isearch-pattern
3509 anything-isearch-message-suffix))
3511 (setq anything-isearch-message-suffix ""))
3514 ;; (@* "Utility: Iswitchb integration (unmaintained)")
3516 (defvar anything-iswitchb-candidate-selected nil
3517 "Indicates whether an anything candidate is selected from iswitchb.")
3519 (defvar anything-iswitchb-frame-configuration nil
3520 "Saved frame configuration, before anything buffer was displayed.")
3522 (defvar anything-iswitchb-saved-keys nil
3523 "The original in iswitchb before binding anything keys.")
3526 (defun anything-iswitchb-setup ()
3527 "Integrate anything completion into iswitchb (UNMAINTAINED).
3529 If the user is idle for `anything-iswitchb-idle-delay' seconds
3530 after typing something into iswitchb then anything candidates are
3531 shown for the current iswitchb input.
3533 ESC cancels anything completion and returns to normal iswitchb.
3535 Some key bindings in `anything-map' are modified.
3536 See also `anything-iswitchb-setup-keys'."
3537 (interactive)
3539 (require 'iswitchb)
3541 ;; disable timid completion during iswitchb
3542 (put 'iswitchb-buffer 'timid-completion 'disabled)
3543 (add-hook 'minibuffer-setup-hook 'anything-iswitchb-minibuffer-setup)
3545 (defadvice iswitchb-visit-buffer
3546 (around anything-iswitchb-visit-buffer activate)
3547 (if anything-iswitchb-candidate-selected
3548 (anything-execute-selection-action)
3549 ad-do-it))
3551 (defadvice iswitchb-possible-new-buffer
3552 (around anything-iswitchb-possible-new-buffer activate)
3553 (if anything-iswitchb-candidate-selected
3554 (anything-execute-selection-action)
3555 ad-do-it))
3556 (anything-iswitchb-setup-keys)
3557 (message "Iswitchb integration is activated."))
3559 (defun anything-iswitchb-setup-keys ()
3560 "Modify `anything-map' for anything-iswitchb users.
3562 C-p is used instead of M-p, because anything uses ESC
3563 (currently hardcoded) for `anything-iswitchb-cancel-anything' and
3564 Emacs handles ESC and Meta as synonyms, so ESC overrides
3565 other commands with Meta prefix.
3567 Note that iswitchb uses M-p and M-n by default for history
3568 navigation, so you should bind C-p and C-n in
3569 `iswitchb-mode-map' if you use the history keys and don't want
3570 to use different keys for iswitchb while anything is not yet
3571 kicked in. These keys are not bound automatically by anything
3572 in `iswitchb-mode-map' because they (C-n at least) already have
3573 a standard iswitchb binding which you might be accustomed to.
3575 Binding M-s is used instead of C-s, because C-s has a binding in
3576 iswitchb. You can rebind it AFTER `anything-iswitchb-setup'.
3578 Unbind C-r to prevent problems during anything-isearch."
3579 (define-key anything-map (kbd "C-s") nil)
3580 (define-key anything-map (kbd "M-p") nil)
3581 (define-key anything-map (kbd "M-n") nil)
3582 (define-key anything-map (kbd "M-v") nil)
3583 (define-key anything-map (kbd "C-v") nil)
3584 (define-key anything-map (kbd "C-p") 'anything-previous-history-element)
3585 (define-key anything-map (kbd "C-n") 'anything-next-history-element)
3586 (define-key anything-map (kbd "M-s") nil)
3587 (define-key anything-map (kbd "M-s") 'anything-isearch)
3588 (define-key anything-map (kbd "C-r") nil))
3590 (defun anything-iswitchb-minibuffer-setup ()
3591 (when (eq this-command 'iswitchb-buffer)
3592 (add-hook 'minibuffer-exit-hook 'anything-iswitchb-minibuffer-exit)
3594 (setq anything-iswitchb-frame-configuration nil)
3595 (setq anything-iswitchb-candidate-selected nil)
3596 (add-hook 'anything-update-hook 'anything-iswitchb-handle-update)
3598 (anything-initialize)
3600 (add-hook 'deferred-action-list 'anything-iswitchb-check-input)))
3603 (defun anything-iswitchb-minibuffer-exit ()
3604 (remove-hook 'minibuffer-exit-hook 'anything-iswitchb-minibuffer-exit)
3605 (remove-hook 'deferred-action-list 'anything-iswitchb-check-input)
3606 (remove-hook 'anything-update-hook 'anything-iswitchb-handle-update)
3608 (anything-cleanup)
3610 (when anything-iswitchb-frame-configuration
3611 (anything-set-frame/window-configuration anything-iswitchb-frame-configuration)
3612 (setq anything-iswitchb-frame-configuration nil)))
3615 (defun anything-iswitchb-check-input ()
3616 "Extract iswitchb input and check if it needs to be handled."
3617 (declare (special iswitchb-text))
3618 (if (or anything-iswitchb-frame-configuration
3619 (sit-for anything-iswitchb-idle-delay))
3620 (anything-check-new-input iswitchb-text)))
3623 (defun anything-iswitchb-handle-update ()
3624 "Pop up the anything buffer if it's not empty and it's not
3625 shown yet and bind anything commands in iswitchb."
3626 (unless (or (anything-empty-buffer-p anything-buffer)
3627 anything-iswitchb-frame-configuration)
3628 (setq anything-iswitchb-frame-configuration (anything-current-frame/window-configuration))
3630 (save-selected-window
3631 (if (not anything-samewindow)
3632 (pop-to-buffer anything-buffer)
3634 (select-window (get-lru-window))
3635 (switch-to-buffer anything-buffer)))
3637 (with-current-buffer (window-buffer (active-minibuffer-window))
3638 (let* ((anything-prefix "anything-")
3639 (prefix-length (length anything-prefix))
3640 (commands
3641 (delete-dups
3642 (remove-if 'null
3643 (mapcar
3644 (lambda (binding)
3645 (let ((command (cdr binding)))
3646 (when (and (symbolp command)
3647 (eq (compare-strings
3648 anything-prefix
3649 0 prefix-length
3650 (symbol-name command)
3651 0 prefix-length)
3653 command)))
3654 (cdr anything-map)))))
3655 (bindings (mapcar (lambda (command)
3656 (cons command
3657 (where-is-internal command anything-map)))
3658 commands)))
3660 (push (list 'anything-iswitchb-cancel-anything (kbd "<ESC>"))
3661 bindings)
3663 (setq anything-iswitchb-saved-keys nil)
3665 (let* ((iswitchb-prefix "iswitchb-")
3666 (prefix-length (length iswitchb-prefix)))
3667 (dolist (binding bindings)
3668 (dolist (key (cdr binding))
3669 (let ((old-command (lookup-key (current-local-map) key)))
3670 (unless (and anything-iswitchb-dont-touch-iswithcb-keys
3671 (symbolp old-command)
3672 (eq (compare-strings iswitchb-prefix
3673 0 prefix-length
3674 (symbol-name old-command)
3675 0 prefix-length)
3677 (push (cons key old-command)
3678 anything-iswitchb-saved-keys)
3679 (define-key (current-local-map) key (car binding)))))))))))
3682 (defun anything-iswitchb-cancel-anything ()
3683 "Cancel anything completion and return to standard iswitchb."
3684 (interactive)
3685 (save-excursion
3686 (dolist (binding anything-iswitchb-saved-keys)
3687 (define-key (current-local-map) (car binding) (cdr binding)))
3688 (anything-iswitchb-minibuffer-exit)))
3690 ;; (@* "Compatibility")
3692 ;; Copied assoc-default from XEmacs version 21.5.12
3693 (unless (fboundp 'assoc-default)
3694 (defun assoc-default (key alist &optional test default)
3695 "Find object KEY in a pseudo-alist ALIST.
3696 ALIST is a list of conses or objects. Each element (or the element's car,
3697 if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY).
3698 If that is non-nil, the element matches;
3699 then `assoc-default' returns the element's cdr, if it is a cons,
3700 or DEFAULT if the element is not a cons.
3702 If no element matches, the value is nil.
3703 If TEST is omitted or nil, `equal' is used."
3704 (let (found (tail alist) value)
3705 (while (and tail (not found))
3706 (let ((elt (car tail)))
3707 (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
3708 (setq found t value (if (consp elt) (cdr elt) default))))
3709 (setq tail (cdr tail)))
3710 value)))
3712 ;; Function not available in XEmacs,
3713 (unless (fboundp 'minibuffer-contents)
3714 (defun minibuffer-contents ()
3715 "Return the user input in a minbuffer as a string.
3716 The current buffer must be a minibuffer."
3717 (field-string (point-max)))
3719 (defun delete-minibuffer-contents ()
3720 "Delete all user input in a minibuffer.
3721 The current buffer must be a minibuffer."
3722 (delete-field (point-max))))
3724 ;; Function not available in older Emacs (<= 22.1).
3725 (unless (fboundp 'buffer-chars-modified-tick)
3726 (defun buffer-chars-modified-tick (&optional buffer)
3727 "Return BUFFER's character-change tick counter.
3728 Each buffer has a character-change tick counter, which is set to the
3729 value of the buffer's tick counter (see `buffer-modified-tick'), each
3730 time text in that buffer is inserted or deleted. By comparing the
3731 values returned by two individual calls of `buffer-chars-modified-tick',
3732 you can tell whether a character change occurred in that buffer in
3733 between these calls. No argument or nil as argument means use current
3734 buffer as BUFFER."
3735 (with-current-buffer (or buffer (current-buffer))
3736 (if (listp buffer-undo-list)
3737 (length buffer-undo-list)
3738 (buffer-modified-tick)))))
3740 ;; (@* "CUA workaround")
3741 (defadvice cua-delete-region (around anything-avoid-cua activate)
3742 (ignore-errors ad-do-it))
3743 (defadvice copy-region-as-kill (around anything-avoid-cua activate)
3744 (if cua-mode
3745 (ignore-errors ad-do-it)
3746 ad-do-it))
3749 ;;(@* "Attribute Documentation")
3750 (defun anything-describe-anything-attribute (anything-attribute)
3751 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol)."
3752 (interactive (list (intern
3753 (completing-read
3754 "Describe anything attribute: "
3755 (mapcar 'symbol-name anything-additional-attributes)))))
3756 (with-output-to-temp-buffer "*Help*"
3757 (princ (get anything-attribute 'anything-attrdoc))))
3759 (anything-document-attribute 'name "mandatory"
3760 " The name of the source. It is also the heading which appears
3761 above the list of matches from the source. Must be unique. ")
3762 (anything-document-attribute 'header-name "optional"
3763 " A function returning the display string of the header. Its
3764 argument is the name of the source. This attribute is useful to
3765 add an additional information with the source name. ")
3766 (anything-document-attribute 'candidates "mandatory if candidates-in-buffer attribute is not provided"
3767 " Specifies how to retrieve candidates from the source. It can
3768 either be a variable name, a function called with no parameters
3769 or the actual list of candidates.
3771 The list must be a list whose members are strings, symbols
3772 or (DISPLAY . REAL) pairs.
3774 In case of (DISPLAY . REAL) pairs, the DISPLAY string is shown
3775 in the Anything buffer, but the REAL one is used as action
3776 argument when the candidate is selected. This allows a more
3777 readable presentation for candidates which would otherwise be,
3778 for example, too long or have a common part shared with other
3779 candidates which can be safely replaced with an abbreviated
3780 string for display purposes.
3782 Note that if the (DISPLAY . REAL) form is used then pattern
3783 matching is done on the displayed string, not on the real
3784 value.
3786 If the candidates have to be retrieved asynchronously (for
3787 example, by an external command which takes a while to run)
3788 then the function should start the external command
3789 asynchronously and return the associated process object.
3790 Anything will take care of managing the process (receiving the
3791 output from it, killing it if necessary, etc.). The process
3792 should return candidates matching the current pattern (see
3793 variable `anything-pattern'.)
3795 Note that currently results from asynchronous sources appear
3796 last in the anything buffer regardless of their position in
3797 `anything-sources'. ")
3798 (anything-document-attribute 'action "mandatory if type attribute is not provided"
3799 " It is a list of (DISPLAY . FUNCTION) pairs or FUNCTION.
3800 FUNCTION is called with one parameter: the selected candidate.
3802 An action other than the default can be chosen from this list
3803 of actions for the currently selected candidate (by default
3804 with TAB). The DISPLAY string is shown in the completions
3805 buffer and the FUNCTION is invoked when an action is
3806 selected. The first action of the list is the default. ")
3807 (anything-document-attribute 'type "optional if action attribute is provided"
3808 " Indicates the type of the items the source returns.
3810 Merge attributes not specified in the source itself from
3811 `anything-type-attributes'.
3813 This attribute is implemented by plug-in. ")
3814 (anything-document-attribute 'init "optional"
3815 " Function called with no parameters when anything is started. It
3816 is useful for collecting current state information which can be
3817 used to create the list of candidates later.
3819 For example, if a source needs to work with the current
3820 directory then it can store its value here, because later
3821 anything does its job in the minibuffer and in the
3822 `anything-buffer' and the current directory can be different
3823 there. ")
3824 (anything-document-attribute 'delayed-init "optional"
3825 " Function called with no parameters before candidate function is
3826 called. It is similar with `init' attribute, but its
3827 evaluation is deferred. It is useful to combine with ")
3828 (anything-document-attribute 'match "optional"
3829 " List of functions called with one parameter: a candidate. The
3830 function should return non-nil if the candidate matches the
3831 current pattern (see variable `anything-pattern').
3833 This attribute allows the source to override the default
3834 pattern matching based on `string-match'. It can be used, for
3835 example, to implement a source for file names and do the
3836 pattern matching on the basename of files, since it's more
3837 likely one is typing part of the basename when searching for a
3838 file, instead of some string anywhere else in its path.
3840 If the list contains more than one function then the list of
3841 matching candidates from the source is constructed by appending
3842 the results after invoking the first function on all the
3843 potential candidates, then the next function, and so on. The
3844 matching candidates supplied by the first function appear first
3845 in the list of results and then results from the other
3846 functions, respectively.
3848 This attribute has no effect for asynchronous sources (see
3849 attribute `candidates'), since they perform pattern matching
3850 themselves. ")
3851 (anything-document-attribute 'candidate-transformer "optional"
3852 " It's a function or a list of functions called with one argument
3853 when the completion list from the source is built. The argument
3854 is the list of candidates retrieved from the source. The
3855 function should return a transformed list of candidates which
3856 will be used for the actual completion. If it is a list of
3857 functions, it calls each function sequentially.
3859 This can be used to transform or remove items from the list of
3860 candidates.
3862 Note that `candidates' is run already, so the given transformer
3863 function should also be able to handle candidates with (DISPLAY
3864 . REAL) format. ")
3865 (anything-document-attribute 'filtered-candidate-transformer "optional"
3866 " It has the same format as `candidate-transformer', except the
3867 function is called with two parameters: the candidate list and
3868 the source.
3870 This transformer is run on the candidate list which is already
3871 filtered by the current pattern. While `candidate-transformer'
3872 is run only once, it is run every time the input pattern is
3873 changed.
3875 It can be used to transform the candidate list dynamically, for
3876 example, based on the current pattern.
3878 In some cases it may also be more efficent to perform candidate
3879 transformation here, instead of with `candidate-transformer'
3880 even if this transformation is done every time the pattern is
3881 changed. For example, if a candidate set is very large then
3882 `candidate-transformer' transforms every candidate while only
3883 some of them will actually be dislpayed due to the limit
3884 imposed by `anything-candidate-number-limit'.
3886 Note that `candidates' and `candidate-transformer' is run
3887 already, so the given transformer function should also be able
3888 to handle candidates with (DISPLAY . REAL) format.
3890 This option has no effect for asynchronous sources. (Not yet,
3891 at least. ")
3892 (anything-document-attribute 'action-transformer "optional"
3893 " It's a function or a list of functions called with two
3894 arguments when the action list from the source is
3895 assembled. The first argument is the list of actions, the
3896 second is the current selection. If it is a list of functions,
3897 it calls each function sequentially.
3899 The function should return a transformed action list.
3901 This can be used to customize the list of actions based on the
3902 currently selected candidate. ")
3903 (anything-document-attribute 'pattern-transformer "optional"
3904 " It's a function or a list of functions called with one argument
3905 before computing matches. Its argument is `anything-pattern'.
3906 Functions should return transformed `anything-pattern'.
3908 It is useful to change interpretation of `anything-pattern'. ")
3909 (anything-document-attribute 'delayed "optional"
3910 " Candidates from the source are shown only if the user stops
3911 typing and is idle for `anything-idle-delay' seconds. ")
3912 (anything-document-attribute 'volatile "optional"
3913 " Indicates the source assembles the candidate list dynamically,
3914 so it shouldn't be cached within a single Anything
3915 invocation. It is only applicable to synchronous sources,
3916 because asynchronous sources are not cached. ")
3917 (anything-document-attribute 'requires-pattern "optional"
3918 " If present matches from the source are shown only if the
3919 pattern is not empty. Optionally, it can have an integer
3920 parameter specifying the required length of input which is
3921 useful in case of sources with lots of candidates. ")
3922 (anything-document-attribute 'persistent-action "optional"
3923 " Function called with one parameter; the selected candidate.
3925 An action performed by `anything-execute-persistent-action'.
3926 If none, use the default action. ")
3927 (anything-document-attribute 'candidates-in-buffer "optional"
3928 " Shortcut attribute for making and narrowing candidates using
3929 buffers. This newly-introduced attribute prevents us from
3930 forgetting to add volatile and match attributes.
3932 See docstring of `anything-candidates-in-buffer'.
3934 (candidates-in-buffer) is equivalent of three attributes:
3935 (candidates . anything-candidates-in-buffer)
3936 (volatile)
3937 (match identity)
3939 (candidates-in-buffer . candidates-function) is equivalent of:
3940 (candidates . candidates-function)
3941 (volatile)
3942 (match identity)
3944 This attribute is implemented by plug-in. ")
3945 (anything-document-attribute 'search "optional"
3946 " List of functions like `re-search-forward' or `search-forward'.
3947 Buffer search function used by `anything-candidates-in-buffer'.
3948 By default, `anything-candidates-in-buffer' uses `re-search-forward'.
3949 This attribute is meant to be used with
3950 (candidates . anything-candidates-in-buffer) or
3951 (candidates-in-buffer) in short. ")
3952 (anything-document-attribute 'search-from-end "optional"
3953 " Make `anything-candidates-in-buffer' search from the end of buffer.
3954 If this attribute is specified, `anything-candidates-in-buffer' uses
3955 `re-search-backward' instead. ")
3956 (anything-document-attribute 'get-line "optional"
3957 " A function like `buffer-substring-no-properties' or `buffer-substring'.
3958 This function converts point of line-beginning and point of line-end,
3959 which represents a candidate computed by `anything-candidates-in-buffer'.
3960 By default, `anything-candidates-in-buffer' uses
3961 `buffer-substring-no-properties'. ")
3962 (anything-document-attribute 'display-to-real "optional"
3963 " Function called with one parameter; the selected candidate.
3965 The function transforms the selected candidate, and the result
3966 is passed to the action function. The display-to-real
3967 attribute provides another way to pass other string than one
3968 shown in Anything buffer.
3970 Traditionally, it is possible to make candidates,
3971 candidate-transformer or filtered-candidate-transformer
3972 function return a list with (DISPLAY . REAL) pairs. But if REAL
3973 can be generated from DISPLAY, display-to-real is more
3974 convenient and faster. ")
3975 (anything-document-attribute 'real-to-display "optional"
3976 " Function called with one parameter; the selected candidate.
3978 The inverse of display-to-real attribute.
3980 The function transforms the selected candidate, which is passed
3981 to the action function, for display. The real-to-display
3982 attribute provides the other way to pass other string than one
3983 shown in Anything buffer.
3985 Traditionally, it is possible to make candidates,
3986 candidate-transformer or filtered-candidate-transformer
3987 function return a list with (DISPLAY . REAL) pairs. But if
3988 DISPLAY can be generated from REAL, real-to-display is more
3989 convenient.
3991 Note that DISPLAY parts returned from candidates /
3992 candidate-transformer are IGNORED as the name `display-to-real'
3993 says. ")
3994 (anything-document-attribute 'cleanup "optional"
3995 " Function called with no parameters when *anything* buffer is closed. It
3996 is useful for killing unneeded candidates buffer.
3998 Note that the function is executed BEFORE performing action. ")
3999 (anything-document-attribute 'candidate-number-limit "optional"
4000 " Override `anything-candidate-number-limit' only for this source. ")
4001 (anything-document-attribute 'accept-empty "optional"
4002 " Pass empty string \"\" to action function. ")
4003 (anything-document-attribute 'disable-shortcuts "optional"
4004 " Disable `anything-enable-shortcuts' in current `anything' session.
4006 This attribute is implemented by plug-in. ")
4007 (anything-document-attribute 'dummy "optional"
4008 " Set `anything-pattern' to candidate. If this attribute is
4009 specified, The candidates attribute is ignored.
4011 This attribute is implemented by plug-in.
4012 This plug-in implies disable-shortcuts plug-in. ")
4013 (anything-document-attribute 'multiline "optional"
4014 " Enable to selection multiline candidates. ")
4015 (anything-document-attribute 'update "optional"
4016 " Function called with no parameters when \\<anything-map>\\[anything-force-update] is pressed. ")
4017 (anything-document-attribute 'mode-line "optional"
4018 " source local `anything-mode-line-string'. (included in `mode-line-format')
4019 It accepts also variable/function name. ")
4020 (anything-document-attribute 'header-line "optional"
4021 " source local `header-line-format'.
4022 It accepts also variable/function name. ")
4023 (anything-document-attribute 'resume "optional" " Function called with no parameters when `anything-resume' is started.")
4025 ;; (@* "Bug Report")
4026 (defvar anything-maintainer-mail-address
4027 (concat "rubiki" "tch@ru" "by-lang.org"))
4028 (defvar anything-bug-report-salutation
4029 "Describe bug below, using a precise recipe.
4031 When I executed M-x ...
4033 How to send a bug report:
4034 1) Be sure to use the LATEST version of anything.el.
4035 2) Enable debugger. M-x toggle-debug-on-error or (setq debug-on-error t)
4036 3) Use Lisp version instead of compiled one: (load \"anything.el\")
4037 4) If you got an error, please paste *Backtrace* buffer.
4038 5) Type C-c C-c to send.
4039 # If you are a Japanese, please write in Japanese:-)")
4040 (defvar anything-no-dump-variables
4041 '(anything-candidate-buffer-alist
4042 anything-digit-overlays
4043 anything-help-message
4044 anything-candidate-cache
4046 "Variables not to dump in bug report.")
4048 (defun anything-dumped-variables-in-bug-report ()
4049 (let ((hash (make-hash-table)))
4050 (loop for var in (apropos-internal "anything-" 'boundp)
4051 for vname = (symbol-name var)
4052 unless (or (string-match "-map$" vname)
4053 (string-match "^anything-c-source-" vname)
4054 (string-match "-hash$" vname)
4055 (string-match "-face$" vname)
4056 (memq var anything-no-dump-variables))
4057 collect var)))
4059 (defun anything-send-bug-report ()
4060 "Send a bug report of anything.el."
4061 (interactive)
4062 (with-current-buffer (or anything-last-buffer
4063 (current-buffer))
4064 (reporter-submit-bug-report
4065 anything-maintainer-mail-address
4066 "anything.el"
4067 (anything-dumped-variables-in-bug-report)
4068 nil nil
4069 anything-bug-report-salutation)))
4071 (defun anything-send-bug-report-from-anything ()
4072 "Send a bug report of anything.el in anything session."
4073 (interactive)
4074 (anything-run-after-quit 'anything-send-bug-report))
4076 ;; (@* "Unit Tests")
4078 (defun* anything-test-candidates (sources &optional (input "") (compile-source-functions anything-compile-source-functions-default))
4079 "Test helper function for anything.
4080 Given pseudo `anything-sources' and `anything-pattern', returns list like
4081 ((\"source name1\" (\"candidate1\" \"candidate2\"))
4082 (\"source name2\" (\"candidate3\" \"candidate4\")))
4084 (let ((anything-test-mode t)
4085 anything-enable-shortcuts
4086 anything-candidate-cache
4087 (anything-compile-source-functions compile-source-functions)
4088 anything-before-initialize-hook
4089 anything-after-initialize-hook
4090 anything-update-hook
4091 anything-test-candidate-list)
4092 (get-buffer-create anything-buffer)
4094 (anything-initialize-1 nil input sources)
4095 (anything-update)
4096 ;; test-mode spec: select 1st candidate!
4097 (with-current-buffer anything-buffer
4098 (forward-line 1)
4099 (anything-mark-current-line))
4100 (prog1
4101 anything-test-candidate-list
4102 (anything-cleanup))))
4104 (defmacro anything-test-update (sources pattern)
4105 "Test helper macro for anything. It is meant for testing *anything* buffer contents."
4106 `(progn (stub anything-get-sources => ,sources)
4107 (stub anything-log-run-hook => nil)
4108 (stub anything-maybe-fit-frame => nil)
4109 (stub run-with-idle-timer => nil)
4110 (let (anything-test-mode (anything-pattern ,pattern))
4111 (anything-update))))
4113 ;;;; unit test
4114 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
4115 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
4116 (dont-compile
4117 (when (fboundp 'expectations)
4118 (expectations
4119 (desc "anything-current-buffer")
4120 (expect "__a_buffer"
4121 (with-current-buffer (get-buffer-create "__a_buffer")
4122 (anything-test-candidates '(((name . "FOO"))) "")
4123 (prog1
4124 (buffer-name anything-current-buffer)
4125 (kill-buffer "__a_buffer")
4127 (desc "anything-buffer-file-name")
4128 (expect (regexp "/__a_file__")
4129 (with-current-buffer (get-buffer-create "__a_file__")
4130 (setq buffer-file-name "/__a_file__")
4131 (anything-test-candidates '(((name . "FOO"))) "")
4132 (prog1
4133 anything-buffer-file-name
4134 ;;(kill-buffer "__a_file__")
4136 (desc "anything-interpret-value")
4137 (expect "literal"
4138 (anything-interpret-value "literal"))
4139 (expect "lambda"
4140 (anything-interpret-value (lambda () "lambda")))
4141 (expect "lambda with source name"
4142 (let ((source '((name . "lambda with source name"))))
4143 (anything-interpret-value (lambda () anything-source-name) source)))
4144 (expect "function symbol"
4145 (flet ((f () "function symbol"))
4146 (anything-interpret-value 'f)))
4147 (expect "variable symbol"
4148 (let ((v "variable symbol"))
4149 (anything-interpret-value 'v)))
4150 (expect (error error *)
4151 (anything-interpret-value 'unbounded-1))
4152 (desc "anything-compile-sources")
4153 (expect '(((name . "foo")))
4154 (anything-compile-sources '(((name . "foo"))) nil)
4156 (expect '(((name . "foo") (type . test) (action . identity)))
4157 (let ((anything-type-attributes '((test (action . identity)))))
4158 (anything-compile-sources '(((name . "foo") (type . test)))
4159 '(anything-compile-source--type))))
4160 (desc "anything-sources accepts symbols")
4161 (expect '(((name . "foo")))
4162 (let* ((foo '((name . "foo"))))
4163 (anything-compile-sources '(foo) nil)))
4164 (desc "anything-get-sources action")
4165 (expect '(((name . "Actions") (candidates . actions)))
4166 (stub anything-action-window => t)
4167 (let (anything-compiled-sources
4168 (anything-sources '(((name . "Actions") (candidates . actions)))))
4169 (anything-get-sources)))
4170 (desc "get-buffer-create candidates-buffer")
4171 (expect '(((name . "many") (init . many-init)
4172 (candidates-in-buffer . anything-candidates-in-buffer)
4173 (candidates . anything-candidates-in-buffer)
4174 (volatile) (match identity)))
4175 (anything-compile-sources
4176 '(((name . "many") (init . many-init)
4177 (candidates-in-buffer . anything-candidates-in-buffer)))
4178 '(anything-compile-source--candidates-in-buffer)))
4179 (expect '(((name . "many") (init . many-init)
4180 (candidates-in-buffer)
4181 (candidates . anything-candidates-in-buffer)
4182 (volatile) (match identity)))
4183 (anything-compile-sources
4184 '(((name . "many") (init . many-init)
4185 (candidates-in-buffer)))
4186 '(anything-compile-source--candidates-in-buffer)))
4187 (expect '(((name . "many") (init . many-init)
4188 (candidates-in-buffer)
4189 (type . test)
4190 (action . identity)
4191 (candidates . anything-candidates-in-buffer)
4192 (volatile) (match identity)))
4193 (let ((anything-type-attributes '((test (action . identity)))))
4194 (anything-compile-sources
4195 '(((name . "many") (init . many-init)
4196 (candidates-in-buffer)
4197 (type . test)))
4198 '(anything-compile-source--type
4199 anything-compile-source--candidates-in-buffer))))
4201 (desc "anything-get-candidates")
4202 (expect '("foo" "bar")
4203 (anything-get-candidates '((name . "foo") (candidates "foo" "bar"))))
4204 (expect '("FOO" "BAR")
4205 (anything-get-candidates '((name . "foo") (candidates "foo" "bar")
4206 (candidate-transformer
4207 . (lambda (cands) (mapcar 'upcase cands))))))
4208 (expect '("foo" "bar")
4209 (anything-get-candidates '((name . "foo")
4210 (candidates . (lambda () '("foo" "bar"))))))
4211 (expect '("foo" "bar")
4212 (let ((var '("foo" "bar")))
4213 (anything-get-candidates '((name . "foo")
4214 (candidates . var)))))
4215 (expect (error error *)
4216 (anything-get-candidates '((name . "foo")
4217 (candidates . "err"))))
4218 (expect (error error *)
4219 (let ((var "err"))
4220 (anything-get-candidates '((name . "foo")
4221 (candidates . var)))))
4222 (expect (error error *)
4223 (anything-get-candidates '((name . "foo")
4224 (candidates . unDeFined-syMbol))))
4225 (desc "anything-compute-matches")
4226 (expect '("foo" "bar")
4227 (let ((anything-pattern ""))
4228 (anything-compute-matches '((name . "FOO") (candidates "foo" "bar") (volatile)))))
4229 (expect '("foo")
4230 (let ((anything-pattern "oo"))
4231 (anything-compute-matches '((name . "FOO") (candidates "foo" "bar") (volatile)))))
4232 (expect '("bar")
4233 (let ((anything-pattern "^b"))
4234 (anything-compute-matches '((name . "FOO") (candidates "foo" "bar") (volatile)))))
4235 (expect '("a" "b")
4236 (let ((anything-pattern "")
4237 (anything-candidate-number-limit 2))
4238 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile)))))
4239 (expect '("a" "b")
4240 (let ((anything-pattern ".")
4241 (anything-candidate-number-limit 2))
4242 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile)))))
4243 (expect '("a" "b" "c")
4244 (let ((anything-pattern "")
4245 anything-candidate-number-limit)
4246 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile)))))
4247 (expect '("a" "b" "c")
4248 (let ((anything-pattern "[abc]")
4249 anything-candidate-number-limit)
4250 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c") (volatile)))))
4251 (expect '(a b c)
4252 (let ((anything-pattern "[abc]")
4253 anything-candidate-number-limit)
4254 (anything-compute-matches '((name . "FOO") (candidates a b c) (volatile)))))
4255 (expect '(("foo" . "FOO") ("bar" . "BAR"))
4256 (let ((anything-pattern ""))
4257 (anything-compute-matches '((name . "FOO") (candidates ("foo" . "FOO") ("bar" . "BAR")) (volatile)))))
4258 (expect '(("foo" . "FOO"))
4259 (let ((anything-pattern "foo"))
4260 (anything-compute-matches '((name . "FOO") (candidates ("foo" . "FOO") ("bar" . "foo")) (volatile)))))
4261 ;; using anything-test-candidate-list
4262 (desc "anything-test-candidates")
4263 (expect '(("FOO" ("foo" "bar")))
4264 (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar")))))
4265 (expect '(("FOO" ("bar")))
4266 (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar"))) "ar"))
4267 (expect '(("T1" ("hoge" "aiue"))
4268 ("T2" ("test" "boke")))
4269 (anything-test-candidates '(((name . "T1") (candidates "hoge" "aiue"))
4270 ((name . "T2") (candidates "test" "boke")))))
4271 (expect '(("T1" ("hoge"))
4272 ("T2" ("boke")))
4273 (anything-test-candidates '(((name . "T1") (candidates "hoge" "aiue"))
4274 ((name . "T2") (candidates "test" "boke"))) "o"))
4275 (desc "requires-pattern attribute")
4276 (expect nil
4277 (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar")
4278 (requires-pattern . 1)))))
4279 (expect '(("FOO" ("bar")))
4280 (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar")
4281 (requires-pattern . 1))) "b"))
4282 (desc "delayed attribute(for test)")
4283 (expect '(("T2" ("boke"))
4284 ("T1" ("hoge")))
4285 (anything-test-candidates
4286 '(((name . "T1") (candidates "hoge" "aiue") (delayed))
4287 ((name . "T2") (candidates "test" "boke")))
4288 "o"))
4289 (desc "match attribute(prefix search)")
4290 (expect '(("FOO" ("bar")))
4291 (anything-test-candidates
4292 '(((name . "FOO") (candidates "foo" "bar")
4293 (match (lambda (c) (string-match (concat "^" anything-pattern) c)))))
4294 "ba"))
4295 (expect nil
4296 (anything-test-candidates
4297 '(((name . "FOO") (candidates "foo" "bar")
4298 (match (lambda (c) (string-match (concat "^" anything-pattern) c)))))
4299 "ar"))
4300 (expect "TestSource"
4301 (let (x)
4302 (anything-test-candidates
4303 '(((name . "TestSource") (candidates "a")
4304 (match (lambda (c) (setq x anything-source-name)))))
4305 "a")
4307 (desc "init attribute")
4308 (expect '(("FOO" ("bar")))
4309 (let (v)
4310 (anything-test-candidates
4311 '(((name . "FOO") (init . (lambda () (setq v '("foo" "bar"))))
4312 (candidates . v)))
4313 "ar")))
4314 (desc "candidate-transformer attribute")
4315 (expect '(("FOO" ("BAR")))
4316 (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar")
4317 (candidate-transformer
4318 . (lambda (cands) (mapcar 'upcase cands)))))
4319 "ar"))
4320 (desc "filtered-candidate-transformer attribute")
4321 ;; needs more tests
4322 (expect '(("FOO" ("BAR")))
4323 (anything-test-candidates '(((name . "FOO") (candidates "foo" "bar")
4324 (filtered-candidate-transformer
4325 . (lambda (cands src) (mapcar 'upcase cands)))))
4326 "ar"))
4327 (desc "anything-transform-candidates in process")
4328 (expect (mock (anything-composed-funcall-with-source
4329 '((name . "FOO") (candidates "foo" "bar")
4330 (filtered-candidate-transformer
4331 . (lambda (cands src) (mapcar 'upcase cands))))
4332 (lambda (cands src) (mapcar 'upcase cands))
4333 '("foo" "bar")
4334 '((name . "FOO") (candidates "foo" "bar")
4335 (filtered-candidate-transformer
4336 . (lambda (cands src) (mapcar 'upcase cands))))
4338 (stub anything-process-candidate-transformer => '("foo" "bar"))
4339 (anything-transform-candidates
4340 '("foo" "bar")
4341 '((name . "FOO") (candidates "foo" "bar")
4342 (filtered-candidate-transformer
4343 . (lambda (cands src) (mapcar 'upcase cands))))
4346 (desc "anything-candidates-in-buffer-1")
4347 (expect nil
4348 (anything-candidates-in-buffer-1
4349 nil ""
4350 'buffer-substring-no-properties '(re-search-forward) 50 nil))
4351 (expect '("foo+" "bar+" "baz+")
4352 (with-temp-buffer
4353 (insert "foo+\nbar+\nbaz+\n")
4354 (anything-candidates-in-buffer-1
4355 (current-buffer) ""
4356 'buffer-substring-no-properties '(re-search-forward) 5 nil)))
4357 (expect '("foo+" "bar+")
4358 (with-temp-buffer
4359 (insert "foo+\nbar+\nbaz+\n")
4360 (anything-candidates-in-buffer-1
4361 (current-buffer) ""
4362 'buffer-substring-no-properties '(re-search-forward) 2 nil)))
4363 (expect '("foo+")
4364 (with-temp-buffer
4365 (insert "foo+\nbar+\nbaz+\n")
4366 (anything-candidates-in-buffer-1
4367 (current-buffer) "oo\\+"
4368 'buffer-substring-no-properties '(re-search-forward) 50 nil)))
4369 (expect '("foo+")
4370 (with-temp-buffer
4371 (insert "foo+\nbar+\nbaz+\n")
4372 (anything-candidates-in-buffer-1
4373 (current-buffer) "oo+"
4374 #'buffer-substring-no-properties '(search-forward) 50 nil)))
4375 (expect '("foo+" "bar+")
4376 (with-temp-buffer
4377 (insert "foo+\nbar+\nbaz+\n")
4378 (anything-candidates-in-buffer-1
4379 (current-buffer) "."
4380 'buffer-substring-no-properties '(re-search-forward) 2 nil)))
4381 (expect '(("foo+" "FOO+"))
4382 (with-temp-buffer
4383 (insert "foo+\nbar+\nbaz+\n")
4384 (anything-candidates-in-buffer-1
4385 (current-buffer) "oo\\+"
4386 (lambda (s e)
4387 (let ((l (buffer-substring-no-properties s e)))
4388 (list l (upcase l))))
4389 '(re-search-forward) 50 nil)))
4390 (desc "anything-candidates-in-buffer")
4391 (expect '(("TEST" ("foo+" "bar+" "baz+")))
4392 (anything-test-candidates
4393 '(((name . "TEST")
4394 (init
4395 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4396 (insert "foo+\nbar+\nbaz+\n"))))
4397 (candidates . anything-candidates-in-buffer)
4398 (match identity)
4399 (volatile)))))
4400 (expect '(("TEST" ("foo+" "bar+" "baz+")))
4401 (let (anything-candidate-number-limit)
4402 (anything-test-candidates
4403 '(((name . "TEST")
4404 (init
4405 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4406 (insert "foo+\nbar+\nbaz+\n"))))
4407 (candidates . anything-candidates-in-buffer)
4408 (match identity)
4409 (volatile))))))
4410 (expect '(("TEST" ("foo+")))
4411 (anything-test-candidates
4412 '(((name . "TEST")
4413 (init
4414 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4415 (insert "foo+\nbar+\nbaz+\n"))))
4416 (candidates . anything-candidates-in-buffer)
4417 (match identity)
4418 (volatile)))
4419 "oo\\+"))
4420 (desc "search attribute")
4421 (expect '(("TEST" ("foo+")))
4422 (anything-test-candidates
4423 '(((name . "TEST")
4424 (init
4425 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4426 (insert "foo+\nbar+\nbaz+\nooo\n"))))
4427 (search search-forward)
4428 (candidates . anything-candidates-in-buffer)
4429 (match identity)
4430 (volatile)))
4431 "oo+"))
4432 (expect '(("TEST" ("foo+" "ooo")))
4433 (anything-test-candidates
4434 '(((name . "TEST")
4435 (init
4436 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4437 (insert "foo+\nbar+\nbaz+\nooo\n"))))
4438 (search search-forward re-search-forward)
4439 (candidates . anything-candidates-in-buffer)
4440 (match identity)
4441 (volatile)))
4442 "oo+"))
4443 (expect '(("TEST" ("foo+" "ooo")))
4444 (anything-test-candidates
4445 '(((name . "TEST")
4446 (init
4447 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4448 (insert "foo+\nbar+\nbaz+\nooo\n"))))
4449 (search re-search-forward search-forward)
4450 (candidates . anything-candidates-in-buffer)
4451 (match identity)
4452 (volatile)))
4453 "oo+"))
4454 (expect '(("TEST" ("ooo" "foo+")))
4455 (anything-test-candidates
4456 '(((name . "TEST")
4457 (init
4458 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4459 (insert "bar+\nbaz+\nooo\nfoo+\n"))))
4460 (search re-search-forward search-forward)
4461 (candidates . anything-candidates-in-buffer)
4462 (match identity)
4463 (volatile)))
4464 "oo+"))
4465 ;; faster exact match
4466 (expect '(("TEST" ("bar+")))
4467 (anything-test-candidates
4468 '(((name . "TEST")
4469 (init
4470 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4471 (insert "bar+\nbaz+\nooo\nfoo+\n"))))
4472 (search (lambda (pattern &rest _)
4473 (and (search-forward (concat "\n" pattern "\n") nil t)
4474 (forward-line -1))))
4475 (candidates . anything-candidates-in-buffer)
4476 (match identity)
4477 (volatile)))
4478 "bar+"))
4479 ;; faster prefix match
4480 (expect '(("TEST" ("bar+")))
4481 (anything-test-candidates
4482 '(((name . "TEST")
4483 (init
4484 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4485 (insert "bar+\nbaz+\nooo\nfoo+\n"))))
4486 (search (lambda (pattern &rest _)
4487 (search-forward (concat "\n" pattern) nil t)))
4488 (candidates . anything-candidates-in-buffer)
4489 (match identity)
4490 (volatile)))
4491 "ba"))
4492 (desc "anything-current-buffer-is-modified")
4493 (expect '(("FOO" ("modified")))
4494 (let ((sources '(((name . "FOO")
4495 (candidates
4496 . (lambda ()
4497 (if (anything-current-buffer-is-modified)
4498 '("modified")
4499 '("unmodified"))))))))
4500 (with-temp-buffer
4501 (clrhash anything-tick-hash)
4502 (insert "1")
4503 (anything-test-candidates sources))))
4504 (expect '(("FOO" ("unmodified")))
4505 (let ((sources '(((name . "FOO")
4506 (candidates
4507 . (lambda ()
4508 (if (anything-current-buffer-is-modified)
4509 '("modified")
4510 '("unmodified"))))))))
4511 (with-temp-buffer
4512 (clrhash anything-tick-hash)
4513 (insert "1")
4514 (anything-test-candidates sources)
4515 (anything-test-candidates sources))))
4516 (expect '(("FOO" ("modified")))
4517 (let ((sources '(((name . "FOO")
4518 (candidates
4519 . (lambda ()
4520 (if (anything-current-buffer-is-modified)
4521 '("modified")
4522 '("unmodified"))))))))
4523 (with-temp-buffer
4524 (clrhash anything-tick-hash)
4525 (insert "1")
4526 (anything-test-candidates sources)
4527 (insert "2")
4528 (anything-test-candidates sources))))
4529 (expect '(("BAR" ("modified")))
4530 (let ((sources1 '(((name . "FOO")
4531 (candidates
4532 . (lambda ()
4533 (if (anything-current-buffer-is-modified)
4534 '("modified")
4535 '("unmodified")))))))
4536 (sources2 '(((name . "BAR")
4537 (candidates
4538 . (lambda ()
4539 (if (anything-current-buffer-is-modified)
4540 '("modified")
4541 '("unmodified"))))))))
4542 (with-temp-buffer
4543 (clrhash anything-tick-hash)
4544 (insert "1")
4545 (anything-test-candidates sources1)
4546 (anything-test-candidates sources2))))
4547 (expect '(("FOO" ("unmodified")))
4548 (let ((sources1 '(((name . "FOO")
4549 (candidates
4550 . (lambda ()
4551 (if (anything-current-buffer-is-modified)
4552 '("modified")
4553 '("unmodified")))))))
4554 (sources2 '(((name . "BAR")
4555 (candidates
4556 . (lambda ()
4557 (if (anything-current-buffer-is-modified)
4558 '("modified")
4559 '("unmodified"))))))))
4560 (with-temp-buffer
4561 (clrhash anything-tick-hash)
4562 (insert "1")
4563 (anything-test-candidates sources1)
4564 (anything-test-candidates sources2)
4565 (anything-test-candidates sources1))))
4566 (expect '(("BAR" ("unmodified")))
4567 (let ((sources1 '(((name . "FOO")
4568 (candidates
4569 . (lambda ()
4570 (if (anything-current-buffer-is-modified)
4571 '("modified")
4572 '("unmodified")))))))
4573 (sources2 '(((name . "BAR")
4574 (candidates
4575 . (lambda ()
4576 (if (anything-current-buffer-is-modified)
4577 '("modified")
4578 '("unmodified"))))))))
4579 (with-temp-buffer
4580 (clrhash anything-tick-hash)
4581 (insert "1")
4582 (anything-test-candidates sources1)
4583 (anything-test-candidates sources2)
4584 (anything-test-candidates sources2))))
4585 (expect '(("BAR" ("modified")))
4586 (let ((sources1 '(((name . "FOO")
4587 (candidates
4588 . (lambda ()
4589 (if (anything-current-buffer-is-modified)
4590 '("modified")
4591 '("unmodified")))))))
4592 (sources2 '(((name . "BAR")
4593 (candidates
4594 . (lambda ()
4595 (if (anything-current-buffer-is-modified)
4596 '("modified")
4597 '("unmodified"))))))))
4598 (with-temp-buffer
4599 (clrhash anything-tick-hash)
4600 (insert "1")
4601 (anything-test-candidates sources1)
4602 (anything-test-candidates sources2)
4603 (with-temp-buffer
4604 (anything-test-candidates sources2)))))
4605 (desc "anything-source-name")
4606 (expect "FOO"
4607 (let (v)
4608 (anything-test-candidates '(((name . "FOO")
4609 (init
4610 . (lambda () (setq v anything-source-name)))
4611 (candidates "ok"))))
4613 (expect "FOO"
4614 (let (v)
4615 (anything-test-candidates '(((name . "FOO")
4616 (candidates
4617 . (lambda ()
4618 (setq v anything-source-name)
4619 '("ok"))))))
4621 (expect "FOO"
4622 (let (v)
4623 (anything-test-candidates '(((name . "FOO")
4624 (candidates "ok")
4625 (candidate-transformer
4626 . (lambda (c)
4627 (setq v anything-source-name)
4628 c)))))
4630 (expect "FOO"
4631 (let (v)
4632 (anything-test-candidates '(((name . "FOO")
4633 (candidates "ok")
4634 (filtered-candidate-transformer
4635 . (lambda (c s)
4636 (setq v anything-source-name)
4637 c)))))
4639 (expect "FOO"
4640 (let (v)
4641 (anything-test-candidates '(((name . "FOO")
4642 (candidates "ok")
4643 (display-to-real
4644 . (lambda (c)
4645 (setq v anything-source-name)
4647 (action . identity))))
4648 (anything-execute-selection-action)
4650 (desc "anything-candidate-buffer create")
4651 (expect " *anything candidates:FOO*"
4652 (let* (anything-candidate-buffer-alist
4653 (anything-source-name "FOO")
4654 (buf (anything-candidate-buffer 'global)))
4655 (prog1 (buffer-name buf)
4656 (kill-buffer buf))))
4657 (expect " *anything candidates:FOO*aTestBuffer"
4658 (let* (anything-candidate-buffer-alist
4659 (anything-source-name "FOO")
4660 (anything-current-buffer (get-buffer-create "aTestBuffer"))
4661 (buf (anything-candidate-buffer 'local)))
4662 (prog1 (buffer-name buf)
4663 (kill-buffer anything-current-buffer)
4664 (kill-buffer buf))))
4665 (expect 0
4666 (let (anything-candidate-buffer-alist
4667 (anything-source-name "FOO") buf)
4668 (with-current-buffer (anything-candidate-buffer 'global)
4669 (insert "1"))
4670 (setq buf (anything-candidate-buffer 'global))
4671 (prog1 (buffer-size buf)
4672 (kill-buffer buf))))
4673 (desc "anything-candidate-buffer get-buffer")
4674 (expect " *anything candidates:FOO*"
4675 (let* (anything-candidate-buffer-alist
4676 (anything-source-name "FOO")
4677 (buf (anything-candidate-buffer 'global)))
4678 (prog1 (buffer-name (anything-candidate-buffer))
4679 (kill-buffer buf))))
4680 (expect " *anything candidates:FOO*aTestBuffer"
4681 (let* (anything-candidate-buffer-alist
4682 (anything-source-name "FOO")
4683 (anything-current-buffer (get-buffer-create "aTestBuffer"))
4684 (buf (anything-candidate-buffer 'local)))
4685 (prog1 (buffer-name (anything-candidate-buffer))
4686 (kill-buffer anything-current-buffer)
4687 (kill-buffer buf))))
4688 (expect " *anything candidates:FOO*"
4689 (let* (anything-candidate-buffer-alist
4690 (anything-source-name "FOO")
4691 (buf-local (anything-candidate-buffer 'local))
4692 (buf-global (anything-candidate-buffer 'global)))
4693 (prog1 (buffer-name (anything-candidate-buffer))
4694 (kill-buffer buf-local)
4695 (kill-buffer buf-global))))
4696 (expect " *anything candidates:FOO*aTestBuffer"
4697 (let* (anything-candidate-buffer-alist
4698 (anything-source-name "FOO")
4699 (anything-current-buffer (get-buffer-create "aTestBuffer"))
4700 (buf-global (anything-candidate-buffer 'global))
4701 (buf-local (anything-candidate-buffer 'local)))
4702 (prog1 (buffer-name (anything-candidate-buffer))
4703 (kill-buffer buf-local)
4704 (kill-buffer buf-global))))
4705 (expect nil
4706 (let* (anything-candidate-buffer-alist
4707 (anything-source-name "NOP__"))
4708 (anything-candidate-buffer)))
4709 (desc "anything-candidate-buffer register-buffer")
4710 (expect " *anything test candidates*"
4711 (let (anything-candidate-buffer-alist
4712 (buf (get-buffer-create " *anything test candidates*")))
4713 (with-current-buffer buf
4714 (insert "1\n2\n")
4715 (prog1 (buffer-name (anything-candidate-buffer buf))
4716 (kill-buffer (current-buffer))))))
4717 (expect " *anything test candidates*"
4718 (let (anything-candidate-buffer-alist
4719 (buf (get-buffer-create " *anything test candidates*")))
4720 (with-current-buffer buf
4721 (insert "1\n2\n")
4722 (anything-candidate-buffer buf)
4723 (prog1 (buffer-name (anything-candidate-buffer))
4724 (kill-buffer (current-buffer))))))
4725 (expect "1\n2\n"
4726 (let (anything-candidate-buffer-alist
4727 (buf (get-buffer-create " *anything test candidates*")))
4728 (with-current-buffer buf
4729 (insert "1\n2\n")
4730 (anything-candidate-buffer buf)
4731 (prog1 (buffer-string)
4732 (kill-buffer (current-buffer))))))
4733 (expect "buf1"
4734 (let (anything-candidate-buffer-alist
4735 (anything-source-name "foo")
4736 (buf1 (get-buffer-create "buf1"))
4737 (buf2 (get-buffer-create "buf2")))
4738 (anything-candidate-buffer buf1)
4739 (anything-candidate-buffer buf2)
4740 (prog1 (buffer-name (anything-candidate-buffer buf1))
4741 (kill-buffer buf1)
4742 (kill-buffer buf2))))
4743 (desc "action attribute")
4744 (expect "foo"
4745 (anything-test-candidates
4746 '(((name . "TEST")
4747 (candidates "foo")
4748 (action ("identity" . identity)))))
4749 (anything-execute-selection-action))
4750 (expect "foo"
4751 (anything-test-candidates
4752 '(((name . "TEST")
4753 (candidates "foo")
4754 (action ("identity" . (lambda (c) (identity c)))))))
4755 (anything-execute-selection-action))
4756 (desc "anything-get-default-action")
4757 (expect 'upcase
4758 (anything-get-default-action '(("upcase" . upcase))))
4759 (expect 'downcase
4760 (anything-get-default-action '(("downcase" . downcase))))
4761 (expect (lambda (x) (capitalize x))
4762 (anything-get-default-action (lambda (x) (capitalize x))))
4763 (expect 'identity
4764 (anything-get-default-action 'identity))
4765 (desc "anything-execute-selection-action")
4766 (expect "FOO"
4767 (anything-execute-selection-action
4768 "foo" '(("upcase" . upcase)) nil))
4769 (expect "FOO"
4770 (anything-execute-selection-action
4771 "foo" '(("upcase" . (lambda (c) (upcase c)))) nil))
4773 (desc "display-to-real attribute")
4774 (expect "FOO"
4775 (anything-test-candidates
4776 '(((name . "TEST")
4777 (candidates "foo")
4778 (display-to-real . upcase)
4779 (action ("identity" . identity)))))
4780 (anything-execute-selection-action))
4781 (desc "cleanup test")
4782 (expect 'cleaned
4783 (let (v)
4784 (anything-test-candidates
4785 '(((name . "TEST")
4786 (cleanup . (lambda () (setq v 'cleaned))))))
4788 (desc "anything-get-current-source")
4789 ;; in init/candidates/action/candidate-transformer/filtered-candidate-transformer
4790 ;; display-to-real/cleanup function
4791 (expect "FOO"
4792 (assoc-default
4793 'name
4794 (anything-funcall-with-source '((name . "FOO")) 'anything-get-current-source)))
4795 ;; init
4796 (expect "FOO"
4797 (let (v)
4798 (anything-test-candidates
4799 '(((name . "FOO")
4800 (init . (lambda () (setq v (anything-get-current-source)))))))
4801 (assoc-default 'name v)))
4802 ;; candidates
4803 (expect "FOO"
4804 (let (v)
4805 (anything-test-candidates
4806 '(((name . "FOO")
4807 (candidates . (lambda () (setq v (anything-get-current-source)) '("a"))))))
4808 (assoc-default 'name v)))
4809 ;; action
4810 (expect "FOO"
4811 (let (v)
4812 (anything-test-candidates
4813 '(((name . "FOO")
4814 (candidates "a")
4815 (action
4816 . (lambda (c) (setq v (anything-get-current-source)) c)))))
4817 (anything-execute-selection-action)
4818 (assoc-default 'name v)))
4819 ;; candidate-transformer
4820 (expect "FOO"
4821 (let (v)
4822 (anything-test-candidates
4823 '(((name . "FOO")
4824 (candidates "a")
4825 (candidate-transformer
4826 . (lambda (c) (setq v (anything-get-current-source)) c)))))
4827 (assoc-default 'name v)))
4828 ;; filtered-candidate-transformer
4829 (expect "FOO"
4830 (let (v)
4831 (anything-test-candidates
4832 '(((name . "FOO")
4833 (candidates "a")
4834 (filtered-candidate-transformer
4835 . (lambda (c s) (setq v (anything-get-current-source)) c)))))
4836 (assoc-default 'name v)))
4837 ;; action-transformer
4838 (expect "FOO"
4839 (let (v)
4840 (anything-test-candidates
4841 '(((name . "FOO")
4842 (candidates "a")
4843 (action-transformer
4844 . (lambda (a c) (setq v (anything-get-current-source)) a))
4845 (action . identity))))
4846 (anything-execute-selection-action)
4847 (assoc-default 'name v)))
4848 ;; display-to-real
4849 (expect "FOO"
4850 (let (v)
4851 (anything-test-candidates
4852 '(((name . "FOO")
4853 (init . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
4854 (insert "a\n"))))
4855 (candidates-in-buffer)
4856 (display-to-real
4857 . (lambda (c) (setq v (anything-get-current-source)) c))
4858 (action . identity))))
4859 (anything-execute-selection-action)
4860 (assoc-default 'name v)))
4861 ;; cleanup
4862 (expect "FOO"
4863 (let (v)
4864 (anything-test-candidates
4865 '(((name . "FOO")
4866 (candidates "a")
4867 (cleanup
4868 . (lambda () (setq v (anything-get-current-source)))))))
4869 (assoc-default 'name v)))
4870 ;; candidates are displayed
4871 (expect "TEST"
4872 (anything-test-candidates
4873 '(((name . "TEST")
4874 (candidates "foo")
4875 (action ("identity" . identity)))))
4876 (assoc-default 'name (anything-get-current-source)))
4877 (desc "anything-attr")
4878 (expect "FOO"
4879 (anything-funcall-with-source
4880 '((name . "FOO"))
4881 (lambda ()
4882 (anything-attr 'name))))
4883 (expect 'fuga
4884 (let (v)
4885 (anything-test-candidates
4886 '(((name . "FOO")
4887 (hoge . fuga)
4888 (init . (lambda () (setq v (anything-attr 'hoge))))
4889 (candidates "a"))))
4891 (expect nil
4892 (let (v)
4893 (anything-test-candidates
4894 '(((name . "FOO")
4895 (init . (lambda () (setq v (anything-attr 'hoge))))
4896 (candidates "a"))))
4898 (expect nil
4899 (let (v)
4900 (anything-test-candidates
4901 '(((name . "FOO")
4902 (hoge) ;INCOMPATIBLE!
4903 (init . (lambda () (setq v (anything-attr 'hoge))))
4904 (candidates "a"))))
4906 (desc "anything-attr*")
4907 (expect "generic"
4908 (let (v (value1 "generic"))
4909 (anything-test-candidates
4910 '(((name . "FOO")
4911 (hoge . value1)
4912 (init . (lambda () (setq v (anything-attr* 'hoge)))))))
4914 (desc "anything-attr-defined")
4915 (expect (non-nil)
4916 (let (v)
4917 (anything-test-candidates
4918 '(((name . "FOO")
4919 (hoge)
4920 (init . (lambda () (setq v (anything-attr-defined 'hoge))))
4921 (candidates "a"))))
4922 v))
4923 (expect nil
4924 (let (v)
4925 (anything-test-candidates
4926 '(((name . "FOO")
4927 (init . (lambda () (setq v (anything-attr-defined 'hoge))))
4928 (candidates "a"))))
4929 v))
4930 (desc "anything-attrset")
4931 (expect '((name . "FOO") (hoge . 77))
4932 (let ((src '((name . "FOO") (hoge))))
4933 (anything-attrset 'hoge 77 src)
4934 src))
4935 (expect 77
4936 (anything-attrset 'hoge 77 '((name . "FOO") (hoge))))
4938 (expect '((name . "FOO") (hoge . 77))
4939 (let ((src '((name . "FOO") (hoge . 1))))
4940 (anything-attrset 'hoge 77 src)
4941 src))
4943 (expect '((name . "FOO") (hoge . 77) (x))
4944 (let ((src '((name . "FOO") (x))))
4945 (anything-attrset 'hoge 77 src)
4946 src))
4947 (expect 77
4948 (anything-attrset 'hoge 77 '((name . "FOO"))))
4949 (desc "anything-preselect")
4950 ;; entire candidate
4951 (expect "foo"
4952 (with-current-buffer (anything-create-anything-buffer t)
4953 (let ((anything-pattern "")
4954 (anything-test-mode t))
4955 (anything-process-source '((name . "test")
4956 (candidates "hoge" "foo" "bar")))
4957 (anything-preselect "foo")
4958 (anything-get-selection))))
4959 ;; regexp
4960 (expect "foo"
4961 (with-current-buffer (anything-create-anything-buffer t)
4962 (let ((anything-pattern "")
4963 (anything-test-mode t))
4964 (anything-process-source '((name . "test")
4965 (candidates "hoge" "foo" "bar")))
4966 (anything-preselect "fo+")
4967 (anything-get-selection))))
4968 ;; no match -> first entry
4969 (expect "hoge"
4970 (with-current-buffer (anything-create-anything-buffer t)
4971 (let ((anything-pattern "")
4972 (anything-test-mode t))
4973 (anything-process-source '((name . "test")
4974 (candidates "hoge" "foo" "bar")))
4975 (anything-preselect "not found")
4976 (anything-get-selection))))
4977 (desc "anything-check-new-input")
4978 (expect "newpattern"
4979 (stub anything-update)
4980 (stub anything-action-window)
4981 (let ((anything-pattern "pattern"))
4982 (anything-check-new-input "newpattern")
4983 anything-pattern))
4984 ;; anything-input == nil when action window is available
4985 (expect nil
4986 (stub anything-update)
4987 (stub anything-action-window => t)
4988 (let ((anything-pattern "pattern")
4989 anything-input)
4990 (anything-check-new-input "newpattern")
4991 anything-input))
4992 ;; anything-input == anything-pattern unless action window is available
4993 (expect "newpattern"
4994 (stub anything-update)
4995 (stub anything-action-window => nil)
4996 (let ((anything-pattern "pattern")
4997 anything-input)
4998 (anything-check-new-input "newpattern")
4999 anything-input))
5000 (expect (mock (anything-update))
5001 (stub anything-action-window)
5002 (let (anything-pattern)
5003 (anything-check-new-input "foo")))
5004 (desc "anything-update")
5005 (expect (mock (anything-process-source '((name . "1"))))
5006 (anything-test-update '(((name . "1"))) ""))
5007 ;; (find-function 'anything-update)
5008 ;; TODO el-mock.el should express 2nd call of function.
5009 ;; (expect (mock (anything-process-source '((name . "2"))))
5010 ;; (stub anything-get-sources => '(((name . "1")) ((name . "2"))))
5011 ;; (stub anything-log-run-hook)
5012 ;; (stub anything-maybe-fit-frame)
5013 ;; (stub run-with-idle-timer)
5014 ;; (anything-update))
5015 (expect (mock (run-with-idle-timer * nil 'anything-process-delayed-sources
5016 '(((name . "2") (delayed)))))
5017 (stub anything-get-sources => '(((name . "1"))
5018 ((name . "2") (delayed))))
5019 (stub anything-log-run-hook)
5020 (stub anything-maybe-fit-frame)
5021 (let ((anything-pattern "") anything-test-mode)
5022 (anything-update)))
5024 (desc "requires-pattern attribute")
5025 (expect (not-called anything-process-source)
5026 (anything-test-update '(((name . "1") (requires-pattern))) ""))
5027 (expect (not-called anything-process-source)
5028 (anything-test-update '(((name . "1") (requires-pattern . 3))) "xx"))
5030 (desc "delay")
5031 (expect (mock (sit-for 0.25))
5032 (stub with-current-buffer)
5033 (let ((anything-idle-delay 1.0)
5034 (anything-input-idle-delay 0.75))
5035 (anything-process-delayed-sources t)))
5036 (expect (mock (sit-for 0.0))
5037 (stub with-current-buffer)
5038 (let ((anything-idle-delay 0.2)
5039 (anything-input-idle-delay 0.5))
5040 (anything-process-delayed-sources t)))
5041 (expect (mock (sit-for 0.5))
5042 (stub with-current-buffer)
5043 (let ((anything-idle-delay 0.5)
5044 (anything-input-idle-delay nil))
5045 (anything-process-delayed-sources t)))
5046 (desc "anything-normalize-sources")
5047 (expect '(anything-c-source-test)
5048 (anything-normalize-sources 'anything-c-source-test))
5049 (expect '(anything-c-source-test)
5050 (anything-normalize-sources '(anything-c-source-test)))
5051 (expect '(anything-c-source-test)
5052 (let ((anything-sources '(anything-c-source-test)))
5053 (anything-normalize-sources nil)))
5054 (expect '(((name . "test")))
5055 (anything-normalize-sources '((name . "test"))))
5056 (expect '(((name . "test")))
5057 (anything-normalize-sources '(((name . "test")))))
5058 (desc "anything-get-action")
5059 (expect '(("identity" . identity))
5060 (stub buffer-size => 1)
5061 (stub anything-get-current-source => '((name . "test")
5062 (action ("identity" . identity))))
5063 (anything-get-action))
5064 (expect '((("identity" . identity)) "action-transformer is called")
5065 (stub buffer-size => 1)
5066 (stub anything-get-current-source
5067 => '((name . "test")
5068 (action ("identity" . identity))
5069 (action-transformer
5070 . (lambda (actions selection)
5071 (list actions selection)))))
5072 (stub anything-get-selection => "action-transformer is called")
5073 (anything-get-action))
5074 (desc "anything-select-nth-action")
5075 (expect "selection"
5076 (stub anything-get-selection => "selection")
5077 (stub anything-exit-minibuffer)
5078 (let (anything-saved-selection)
5079 (anything-select-nth-action 1)
5080 anything-saved-selection))
5081 (expect 'cadr
5082 (stub anything-get-action => '(("0" . car) ("1" . cdr) ("2" . cadr)))
5083 (stub anything-exit-minibuffer)
5084 (stub anything-get-selection => "selection")
5085 (let (anything-saved-action)
5086 (anything-select-nth-action 2)
5087 anything-saved-action))
5088 (desc "anything-funcall-foreach")
5089 (expect (mock (upcase "foo"))
5090 (stub anything-get-sources => '(((init . (lambda () (upcase "foo"))))))
5091 (anything-funcall-foreach 'init))
5092 (expect (mock (downcase "bar"))
5093 (stub anything-get-sources => '(((init . (lambda () (upcase "foo"))))
5094 ((init . (lambda () (downcase "bar"))))))
5095 (anything-funcall-foreach 'init))
5096 (expect (not-called anything-funcall-with-source)
5097 (stub anything-get-sources => '(((init . (lambda () (upcase "foo"))))))
5098 (anything-funcall-foreach 'not-found))
5099 ;; TODO anything-select-with-digit-shortcut test
5100 (desc "anything-get-cached-candidates")
5101 (expect '("cached" "version")
5102 (let ((anything-candidate-cache '(("test" "cached" "version"))))
5103 (anything-get-cached-candidates '((name . "test")
5104 (candidates "new")))))
5105 (expect '("new")
5106 (let ((anything-candidate-cache '(("other" "cached" "version"))))
5107 (anything-get-cached-candidates '((name . "test")
5108 (candidates "new")))))
5109 (expect '(("test" "new")
5110 ("other" "cached" "version"))
5111 (let ((anything-candidate-cache '(("other" "cached" "version"))))
5112 (anything-get-cached-candidates '((name . "test")
5113 (candidates "new")))
5114 anything-candidate-cache))
5115 (expect '(("other" "cached" "version"))
5116 (let ((anything-candidate-cache '(("other" "cached" "version"))))
5117 (anything-get-cached-candidates '((name . "test")
5118 (candidates "new")
5119 (volatile)))
5120 anything-candidate-cache))
5121 ;; TODO when candidates == process
5122 ;; TODO anything-output-filter
5123 (desc "candidate-number-limit attribute")
5124 (expect '("a" "b")
5125 (let ((anything-pattern "")
5126 (anything-candidate-number-limit 20))
5127 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c")
5128 (candidate-number-limit . 2) (volatile)))))
5129 (expect '("a" "b")
5130 (let ((anything-pattern "[abc]")
5131 (anything-candidate-number-limit 20))
5132 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c")
5133 (candidate-number-limit . 2) (volatile)))))
5134 (expect '("a" "b" "c" "d")
5135 (let ((anything-pattern "[abcd]")
5136 (anything-candidate-number-limit 2))
5137 (anything-compute-matches '((name . "FOO") (candidates "a" "b" "c" "d")
5138 (candidate-number-limit) (volatile)))))
5139 (expect '(("TEST" ("a" "b" "c")))
5140 (let ((anything-candidate-number-limit 2))
5141 (anything-test-candidates
5142 '(((name . "TEST")
5143 (init
5144 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5145 (insert "a\nb\nc\nd\n"))))
5146 (candidates . anything-candidates-in-buffer)
5147 (match identity)
5148 (candidate-number-limit . 3)
5149 (volatile))))))
5150 (expect '(("TEST" ("a" "b" "c")))
5151 (let ((anything-candidate-number-limit 2))
5152 (anything-test-candidates
5153 '(((name . "TEST")
5154 (init
5155 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5156 (insert "a\nb\nc\nd\n"))))
5157 (candidates . anything-candidates-in-buffer)
5158 (match identity)
5159 (candidate-number-limit . 3)
5160 (volatile)))
5161 ".")))
5162 (desc "multiple init")
5163 (expect '(1 . 2)
5164 (let (a b)
5165 (anything-test-candidates
5166 '(((name . "test")
5167 (init (lambda () (setq a 1))
5168 (lambda () (setq b 2))))))
5169 (cons a b)))
5170 (expect 1
5171 (let (a)
5172 (anything-test-candidates
5173 '(((name . "test")
5174 (init (lambda () (setq a 1))))))
5176 (desc "multiple cleanup")
5177 (expect '(1 . 2)
5178 (let (a b)
5179 (anything-test-candidates
5180 '(((name . "test")
5181 (cleanup (lambda () (setq a 1))
5182 (lambda () (setq b 2))))))
5183 (cons a b)))
5184 (desc "anything-mklist")
5185 (expect '(1)
5186 (anything-mklist 1))
5187 (expect '(2)
5188 (anything-mklist '(2)))
5189 (expect '((lambda ()))
5190 (anything-mklist (lambda ())))
5191 (desc "anything-before-initialize-hook")
5192 (expect 'called
5193 (let ((anything-before-initialize-hook '((lambda () (setq v 'called))))
5195 (anything-initialize)
5197 (desc "anything-after-initialize-hook")
5198 (expect '(b a)
5199 (let ((anything-before-initialize-hook
5200 '((lambda () (setq v '(a)))))
5201 (anything-after-initialize-hook
5202 '((lambda () (setq v (cons 'b v)))))
5204 (anything-initialize)
5206 (expect 0
5207 (let ((anything-after-initialize-hook
5208 '((lambda () (setq v (buffer-size (get-buffer anything-buffer))))))
5210 (anything-initialize)
5212 (desc "get-line attribute")
5213 (expect '(("TEST" ("FOO+")))
5214 (anything-test-candidates
5215 '(((name . "TEST")
5216 (init
5217 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5218 (insert "foo+\nbar+\nbaz+\n"))))
5219 (candidates-in-buffer)
5220 (get-line . (lambda (s e) (upcase (buffer-substring-no-properties s e))))))
5221 "oo\\+"))
5222 (desc "with-anything-restore-variables")
5223 (expect '(7 8)
5224 (let ((a 7) (b 8)
5225 (anything-restored-variables '(a b)))
5226 (with-anything-restore-variables
5227 (setq a 0 b 0))
5228 (list a b)))
5229 (desc "anything-cleanup-hook")
5230 (expect 'called
5231 (let ((anything-cleanup-hook
5232 '((lambda () (setq v 'called))))
5234 (anything-cleanup)
5236 (desc "with-anything-display-same-window")
5237 (expect (non-nil)
5238 (save-window-excursion
5239 (delete-other-windows)
5240 (split-window)
5242 (let ((buf (get-buffer-create " tmp"))
5243 (win (selected-window)))
5244 (with-anything-display-same-window
5245 (display-buffer buf)
5246 (eq win (get-buffer-window buf))))))
5247 (expect (non-nil)
5248 (save-window-excursion
5249 (delete-other-windows)
5250 (split-window)
5252 (let ((buf (get-buffer-create " tmp"))
5253 (win (selected-window)))
5254 (with-anything-display-same-window
5255 (pop-to-buffer buf)
5256 (eq win (get-buffer-window buf))))))
5257 (expect (non-nil)
5258 (save-window-excursion
5259 (delete-other-windows)
5260 (split-window)
5262 (let ((buf (get-buffer-create " tmp"))
5263 (win (selected-window)))
5264 (with-anything-display-same-window
5265 (switch-to-buffer buf)
5266 (eq win (get-buffer-window buf))))))
5267 (expect (non-nil)
5268 (save-window-excursion
5269 (delete-other-windows)
5270 (let ((buf (get-buffer-create " tmp"))
5271 (win (selected-window)))
5272 (with-anything-display-same-window
5273 (display-buffer buf)
5274 (eq win (get-buffer-window buf))))))
5275 (expect (non-nil)
5276 (save-window-excursion
5277 (delete-other-windows)
5278 (let ((buf (get-buffer-create " tmp"))
5279 (win (selected-window)))
5280 (with-anything-display-same-window
5281 (pop-to-buffer buf)
5282 (eq win (get-buffer-window buf))))))
5283 (desc "search-from-end attribute")
5284 (expect '(("TEST" ("baz+" "bar+" "foo+")))
5285 (anything-test-candidates
5286 '(((name . "TEST")
5287 (init
5288 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5289 (insert "foo+\nbar+\nbaz+\n"))))
5290 (candidates-in-buffer)
5291 (search-from-end)))))
5292 (expect '(("TEST" ("baz+" "bar+" "foo+")))
5293 (anything-test-candidates
5294 '(((name . "TEST")
5295 (init
5296 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5297 (insert "foo+\nbar+\nbaz+\n"))))
5298 (candidates-in-buffer)
5299 (search-from-end)))
5300 "\\+"))
5301 (expect '(("TEST" ("baz+" "bar+")))
5302 (anything-test-candidates
5303 '(((name . "TEST")
5304 (init
5305 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5306 (insert "foo+\nbar+\nbaz+\n"))))
5307 (candidates-in-buffer)
5308 (search-from-end)
5309 (candidate-number-limit . 2)))))
5310 (expect '(("TEST" ("baz+" "bar+")))
5311 (anything-test-candidates
5312 '(((name . "TEST")
5313 (init
5314 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5315 (insert "foo+\nbar+\nbaz+\n"))))
5316 (candidates-in-buffer)
5317 (search-from-end)
5318 (candidate-number-limit . 2)))
5319 "\\+"))
5321 (desc "header-name attribute")
5322 (expect "original is transformed"
5323 (anything-test-update '(((name . "original")
5324 (candidates "1")
5325 (header-name
5326 . (lambda (name)
5327 (format "%s is transformed" name)))))
5329 (with-current-buffer (anything-buffer-get)
5330 (buffer-string)
5331 (overlay-get (car (overlays-at (1+(point-min)))) 'display)))
5332 (desc "volatile and match attribute")
5333 ;; candidates function is called once per `anything-process-delayed-sources'
5334 (expect 1
5335 (let ((v 0))
5336 (anything-test-candidates '(((name . "test")
5337 (candidates . (lambda () (incf v) '("ok")))
5338 (volatile)
5339 (match identity identity identity)))
5340 "o")
5342 (desc "accept-empty attribute")
5343 (expect nil
5344 (anything-test-candidates
5345 '(((name . "test") (candidates "") (action . identity))))
5346 (anything-execute-selection-action))
5347 (expect ""
5348 (anything-test-candidates
5349 '(((name . "test") (candidates "") (action . identity) (accept-empty))))
5350 (anything-execute-selection-action))
5351 (desc "anything-tick-hash")
5352 (expect nil
5353 (with-current-buffer (get-buffer-create " *00create+*")
5354 (puthash " *00create+*/xxx" 1 anything-tick-hash)
5355 (kill-buffer (current-buffer)))
5356 (gethash " *00create+*/xxx" anything-tick-hash))
5357 (desc "anything-execute-action-at-once-if-once")
5358 (expect "HOGE"
5359 (let ((anything-execute-action-at-once-if-one t))
5360 (anything '(((name . "one test1")
5361 (candidates "hoge")
5362 (action . upcase))))))
5363 (expect "ANY"
5364 (let ((anything-execute-action-at-once-if-one t))
5365 (anything '(((name . "one test2")
5366 (candidates "hoge" "any")
5367 (action . upcase)))
5368 "an")))
5369 ;; candidates > 1
5370 (expect (mock (read-string "word: " nil))
5371 (let ((anything-execute-action-at-once-if-one t))
5372 (anything '(((name . "one test3")
5373 (candidates "hoge" "foo" "bar")
5374 (action . identity)))
5375 nil "word: ")))
5376 (desc "anything-quit-if-no-candidate")
5377 (expect nil
5378 (let ((anything-quit-if-no-candidate t))
5379 (anything '(((name . "zero test1") (candidates) (action . upcase))))))
5380 (expect 'called
5381 (let (v (anything-quit-if-no-candidate (lambda () (setq v 'called))))
5382 (anything '(((name . "zero test2") (candidates) (action . upcase))))
5384 (desc "real-to-display attribute")
5385 (expect '(("test" (("DDD" . "ddd"))))
5386 (anything-test-candidates '(((name . "test")
5387 (candidates "ddd")
5388 (real-to-display . upcase)
5389 (action . identity)))))
5390 (expect '(("test" (("DDD" . "ddd"))))
5391 (anything-test-candidates '(((name . "test")
5392 (candidates ("ignored" . "ddd"))
5393 (real-to-display . upcase)
5394 (action . identity)))))
5395 (expect '(("Commands" (("xxxhoge" . "hoge") ("xxxboke" . "boke"))))
5396 (anything-test-candidates '(((name . "Commands")
5397 (candidates
5398 "hoge" "boke")
5399 (real-to-display . (lambda (x) (concat "xxx" x)))
5400 (action . identity)))
5401 "xxx"))
5402 (expect "test\nDDD\n"
5403 (anything-test-update '(((name . "test")
5404 (candidates "ddd")
5405 (real-to-display . upcase)
5406 (action . identity)))
5408 (with-current-buffer (anything-buffer-get) (buffer-string)))
5409 (desc "real-to-display and candidate-transformer attribute")
5410 (expect '(("test" (("DDD" . "ddd"))))
5411 (anything-test-candidates
5412 '(((name . "test")
5413 (candidates "ddd")
5414 (candidate-transformer (lambda (cands) (mapcar (lambda (c) (cons "X" c)) cands)))
5415 (real-to-display . upcase)
5416 (action . identity)))))
5417 (expect "test\nDDD\n"
5418 (anything-test-update
5419 '(((name . "test")
5420 (candidates "ddd")
5421 (candidate-transformer (lambda (cands) (mapcar (lambda (c) (cons "X" c)) cands)))
5422 (real-to-display . upcase)
5423 (action . identity)))
5425 (with-current-buffer (anything-buffer-get) (buffer-string)))
5426 (desc "real-to-display and candidates-in-buffer")
5427 (expect '(("test" (("A" . "a") ("B" . "b"))))
5428 (anything-test-candidates
5429 '(((name . "test")
5430 (init
5431 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5432 (erase-buffer)
5433 (insert "a\nb\n"))))
5434 (candidates-in-buffer)
5435 (real-to-display . upcase)
5436 (action . identity)))))
5437 (expect "test\nA\nB\n"
5438 (stub read-string)
5439 (anything
5440 '(((name . "test")
5441 (init
5442 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5443 (erase-buffer)
5444 (insert "a\nb\n"))))
5445 (candidates-in-buffer)
5446 (real-to-display . upcase)
5447 (action . identity))))
5448 (with-current-buffer (anything-buffer-get) (buffer-string)))
5449 (desc "Symbols are acceptable as candidate.")
5450 (expect '(("test" (sym "str")))
5451 (anything-test-candidates
5452 '(((name . "test")
5453 (candidates sym "str")))))
5454 (expect '(("test" ((sym . realsym) ("str" . "realstr"))))
5455 (anything-test-candidates
5456 '(((name . "test")
5457 (candidates (sym . realsym) ("str" . "realstr"))))))
5458 (expect '(("test" (sym)))
5459 (anything-test-candidates
5460 '(((name . "test")
5461 (candidates sym "str")))
5462 "sym"))
5463 (expect '(("test" ("str")))
5464 (anything-test-candidates
5465 '(((name . "test")
5466 (candidates sym "str")))
5467 "str"))
5468 (expect '(("test" ((sym . realsym))))
5469 (anything-test-candidates
5470 '(((name . "test")
5471 (candidates (sym . realsym) ("str" . "realstr"))))
5472 "sym"))
5473 (expect '(("test" (("str" . "realstr"))))
5474 (anything-test-candidates
5475 '(((name . "test")
5476 (candidates (sym . realsym) ("str" . "realstr"))))
5477 "str"))
5478 (desc "multiple transformers")
5479 (expect '(("test" ("<FOO>")))
5480 (anything-test-candidates
5481 '(((name . "test")
5482 (candidates "foo")
5483 (candidate-transformer
5484 . (lambda (cands)
5485 (anything-compose (list cands)
5486 (list (lambda (c) (mapcar 'upcase c))
5487 (lambda (c) (list (concat "<" (car c) ">")))))))))))
5488 (expect '("<FOO>")
5489 (anything-composed-funcall-with-source
5490 '((name . "test"))
5491 (list (lambda (c) (mapcar 'upcase c))
5492 (lambda (c) (list (concat "<" (car c) ">"))))
5493 '("foo"))
5495 (expect '(("test" ("<FOO>")))
5496 (anything-test-candidates
5497 '(((name . "test")
5498 (candidates "foo")
5499 (candidate-transformer
5500 (lambda (c) (mapcar 'upcase c))
5501 (lambda (c) (list (concat "<" (car c) ">"))))))))
5502 (expect '(("test" ("<BAR>")))
5503 (anything-test-candidates
5504 '(((name . "test")
5505 (candidates "bar")
5506 (filtered-candidate-transformer
5507 (lambda (c s) (mapcar 'upcase c))
5508 (lambda (c s) (list (concat "<" (car c) ">"))))))))
5509 (expect '(("find-file" . find-file)
5510 ("view-file" . view-file))
5511 (stub zerop => nil)
5512 (stub anything-get-current-source
5513 => '((name . "test")
5514 (action)
5515 (action-transformer
5516 . (lambda (a s)
5517 (anything-compose
5518 (list a s)
5519 (list (lambda (a s) (push '("view-file" . view-file) a))
5520 (lambda (a s) (push '("find-file" . find-file) a))))))))
5521 (anything-get-action))
5522 (expect '(("find-file" . find-file)
5523 ("view-file" . view-file))
5524 (stub zerop => nil)
5525 (stub anything-get-current-source
5526 => '((name . "test")
5527 (action)
5528 (action-transformer
5529 (lambda (a s) (push '("view-file" . view-file) a))
5530 (lambda (a s) (push '("find-file" . find-file) a)))))
5531 (anything-get-action))
5532 (desc "define-anything-type-attribute")
5533 (expect '((file (action . find-file)))
5534 (let (anything-type-attributes)
5535 (define-anything-type-attribute 'file '((action . find-file)))
5536 anything-type-attributes))
5537 (expect '((file (action . find-file)))
5538 (let ((anything-type-attributes '((file (action . view-file)))))
5539 (define-anything-type-attribute 'file '((action . find-file)))
5540 anything-type-attributes))
5541 (expect '((file (action . find-file))
5542 (buffer (action . switch-to-buffer)))
5543 (let (anything-type-attributes)
5544 (define-anything-type-attribute 'buffer '((action . switch-to-buffer)))
5545 (define-anything-type-attribute 'file '((action . find-file)))
5546 anything-type-attributes))
5547 (desc "anything-approximate-candidate-number")
5548 (expect 0
5549 (with-temp-buffer
5550 (let ((anything-buffer (current-buffer)))
5551 (anything-approximate-candidate-number))))
5552 (expect 1
5553 (with-temp-buffer
5554 (let ((anything-buffer (current-buffer)))
5555 (insert "Title\n"
5556 "candiate1\n")
5557 (anything-approximate-candidate-number))))
5558 (expect t
5559 (with-temp-buffer
5560 (let ((anything-buffer (current-buffer)))
5561 (insert "Title\n"
5562 "candiate1\n"
5563 "candiate2\n")
5564 (<= 2 (anything-approximate-candidate-number)))))
5565 (expect 1
5566 (with-temp-buffer
5567 (let ((anything-buffer (current-buffer)))
5568 (insert "Title\n"
5569 (propertize "multi\nline\n" 'anything-multiline t))
5570 (anything-approximate-candidate-number))))
5571 (expect t
5572 (with-temp-buffer
5573 (let ((anything-buffer (current-buffer))
5574 (anything-candidate-separator "-----"))
5575 (insert "Title\n"
5576 (propertize "multi\nline1\n" 'anything-multiline t)
5577 "-----\n"
5578 (propertize "multi\nline2\n" 'anything-multiline t))
5579 (<= 2 (anything-approximate-candidate-number)))))
5580 (desc "delayed-init attribute")
5581 (expect 0
5582 (let ((value 0))
5583 (anything-test-candidates '(((name . "test")
5584 (delayed-init . (lambda () (incf value)))
5585 (candiates "abc")
5586 (requires-pattern . 2)))
5588 value))
5589 (expect 1
5590 (let ((value 0))
5591 (anything-test-candidates '(((name . "test")
5592 (delayed-init . (lambda () (incf value)))
5593 (candiates "abc")
5594 (requires-pattern . 2)))
5595 "abc")
5596 value))
5597 (expect 2
5598 (let ((value 0))
5599 (anything-test-candidates '(((name . "test")
5600 (delayed-init (lambda () (incf value))
5601 (lambda () (incf value)))
5602 (candiates "abc")
5603 (requires-pattern . 2)))
5604 "abc")
5605 value))
5606 (expect t
5607 (let (value)
5608 (with-temp-buffer
5609 (anything-test-candidates '(((name . "test")
5610 (delayed-init
5611 . (lambda () (setq value
5612 (eq anything-current-buffer (current-buffer)))))
5613 (candiates "abc")
5614 (requires-pattern . 2)))
5615 "abc")
5616 value)))
5617 (desc "pattern-transformer attribute")
5618 (expect '(("test2" ("foo")) ("test3" ("bar")))
5619 (anything-test-candidates '(((name . "test1")
5620 (candidates "foo" "bar"))
5621 ((name . "test2")
5622 (pattern-transformer . (lambda (pat) (substring pat 1)))
5623 (candidates "foo" "bar"))
5624 ((name . "test3")
5625 (pattern-transformer . (lambda (pat) "bar"))
5626 (candidates "foo" "bar")))
5627 "xfoo"))
5628 (expect '(("test2" ("foo")) ("test3" ("bar")))
5629 (anything-test-candidates '(((name . "test1")
5630 (candidates "foo" "bar"))
5631 ((name . "test2")
5632 (pattern-transformer (lambda (pat) (substring pat 1)))
5633 (candidates "foo" "bar"))
5634 ((name . "test3")
5635 (pattern-transformer (lambda (pat) "bar"))
5636 (candidates "foo" "bar")))
5637 "xfoo"))
5638 (expect '(("test2" ("foo")) ("test3" ("bar")))
5639 (anything-test-candidates '(((name . "test1")
5640 (init
5641 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5642 (insert "foo\nbar\n"))))
5643 (candidates-in-buffer))
5644 ((name . "test2")
5645 (pattern-transformer . (lambda (pat) (substring pat 1)))
5646 (init
5647 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5648 (insert "foo\nbar\n"))))
5649 (candidates-in-buffer))
5650 ((name . "test3")
5651 (pattern-transformer . (lambda (pat) "bar"))
5652 (init
5653 . (lambda () (with-current-buffer (anything-candidate-buffer 'global)
5654 (insert "foo\nbar\n"))))
5655 (candidates-in-buffer)))
5656 "xfoo"))
5657 (desc "anything-recent-push")
5658 (expect '("foo" "bar" "baz")
5659 (let ((lst '("bar" "baz")))
5660 (anything-recent-push "foo" 'lst)))
5661 (expect '("foo" "bar" "baz")
5662 (let ((lst '("foo" "bar" "baz")))
5663 (anything-recent-push "foo" 'lst)))
5664 (expect '("foo" "bar" "baz")
5665 (let ((lst '("bar" "foo" "baz")))
5666 (anything-recent-push "foo" 'lst)))
5667 (desc "anything-require-at-least-version")
5668 (expect nil
5669 (anything-require-at-least-version "1.1"))
5670 (expect nil
5671 (anything-require-at-least-version "1.200"))
5672 (expect nil
5673 (anything-require-at-least-version
5674 (and (string-match "1\.\\([0-9]+\\)" anything-version)
5675 (match-string 0 anything-version))))
5676 (expect (error)
5677 (anything-require-at-least-version "1.999"))
5678 (expect (error)
5679 (anything-require-at-least-version "1.2000"))
5680 (desc "anything-once")
5681 (expect 2
5682 (let ((i 0))
5683 (anything-test-candidates
5684 '(((name . "1")
5685 (init . (lambda () (incf i))))
5686 ((name . "2")
5687 (init . (lambda () (incf i))))))
5689 (expect 1
5690 (let ((i 0))
5691 (anything-test-candidates
5692 '(((name . "1")
5693 (init . (lambda () (anything-once (lambda () (incf i))))))
5694 ((name . "2")
5695 (init . (lambda () (anything-once (lambda () (incf i))))))))
5697 (expect 1
5698 (let ((i 0))
5699 (flet ((init1 () (anything-once (lambda () (incf i)))))
5700 (anything-test-candidates
5701 '(((name . "1")
5702 (init . init1))
5703 ((name . "2")
5704 (init . init1)))))
5706 (desc "anything-marked-candidates")
5707 (expect '("mark3" "mark1")
5708 (let* ((source '((name . "mark test")))
5709 (anything-marked-candidates
5710 `((,source . "mark1")
5711 (((name . "other")) . "mark2")
5712 (,source . "mark3"))))
5713 (stub anything-buffer-get => (current-buffer))
5714 (stub anything-get-current-source => source)
5715 (anything-marked-candidates)))
5716 (expect '("current")
5717 (let* ((source '((name . "mark test")))
5718 (anything-marked-candidates nil))
5719 (stub anything-get-current-source => source)
5720 (stub anything-get-selection => "current")
5721 (anything-marked-candidates)))
5722 (desc "anything-let")
5723 (expect '(1 10000 nil)
5724 (let ((a 9999)
5725 (b 8)
5727 (anything-buffer (exps-tmpbuf)))
5728 (anything-let ((a 1)
5729 (b (1+ a))
5731 (anything-create-anything-buffer))
5732 (with-current-buffer anything-buffer
5733 (list a b c))))
5734 (expect (non-nil)
5735 (let ((a 9999)
5736 (b 8)
5738 (anything-buffer (exps-tmpbuf)))
5739 (anything-let ((a 1)
5740 (b (1+ a))
5742 (anything-create-anything-buffer))
5743 (with-current-buffer anything-buffer
5744 (and (assq 'a (buffer-local-variables))
5745 (assq 'b (buffer-local-variables))
5746 (assq 'c (buffer-local-variables))))))
5747 (expect 'retval
5748 (let ((a 9999)
5749 (b 8)
5751 (anything-buffer (exps-tmpbuf)))
5752 (anything-let ((a 1)
5753 (b (1+ a))
5755 'retval)))
5756 (desc "anything-let*")
5757 (expect '(1 2 nil)
5758 (let ((a 9999)
5759 (b 8)
5761 (anything-buffer (exps-tmpbuf)))
5762 (anything-let* ((a 1)
5763 (b (1+ a))
5765 (anything-create-anything-buffer))
5766 (with-current-buffer anything-buffer
5767 (list a b c))))
5768 (expect (non-nil)
5769 (let ((a 9999)
5770 (b 8)
5772 (anything-buffer (exps-tmpbuf)))
5773 (anything-let* ((a 1)
5774 (b (1+ a))
5776 (anything-create-anything-buffer))
5777 (with-current-buffer anything-buffer
5778 (and (assq 'a (buffer-local-variables))
5779 (assq 'b (buffer-local-variables))
5780 (assq 'c (buffer-local-variables))))))
5781 (expect 'retval*
5782 (let ((a 9999)
5783 (b 8)
5785 (anything-buffer (exps-tmpbuf)))
5786 (anything-let* ((a 1)
5787 (b (1+ a))
5789 'retval*)))
5790 (desc "anything with keyword")
5791 (expect (mock (anything-internal 'test-source "input" "prompt: " nil "preselect" "*test*" nil))
5792 (anything :sources 'test-source
5793 :input "input"
5794 :prompt "prompt: "
5795 :resume nil
5796 :preselect "preselect"
5797 :buffer "*test*"
5798 :keymap nil))
5799 (expect (mock (anything-internal 'test-source nil nil nil nil "*test*" nil))
5800 (anything :sources 'test-source
5801 :buffer "*test*"
5802 :candidate-number-limit 20))
5803 (expect (mock (anything-internal 'test-source nil nil nil nil "*test*" nil))
5804 (anything 'test-source nil nil nil nil "*test*" nil))
5805 (desc "anything-log-eval-internal")
5806 (expect (mock (anything-log "%S = %S" '(+ 1 2) 3))
5807 (anything-log-eval-internal '((+ 1 2))))
5808 (expect (mock (anything-log "%S = ERROR!" 'unDeFined))
5809 (anything-log-eval-internal '(unDeFined)))
5811 (desc "anything-output-filter--collect-candidates")
5812 (expect '("a" "b" "")
5813 (split-string "a\nb\n" "\n"))
5814 (expect '("a" "b")
5815 (anything-output-filter--collect-candidates
5816 '("a" "b" "") (cons 'incomplete-line "")))
5817 (expect '("a" "b")
5818 (split-string "a\nb" "\n"))
5819 (expect '("a")
5820 (anything-output-filter--collect-candidates
5821 '("a" "b") (cons 'incomplete-line "")))
5822 (expect '(incomplete-line . "b")
5823 (let ((incomplete-line-info (cons 'incomplete-line "")))
5824 (anything-output-filter--collect-candidates
5825 '("a" "b") incomplete-line-info)
5826 incomplete-line-info))
5827 (expect '("" "c" "")
5828 (split-string "\nc\n" "\n"))
5829 (expect '("b" "c")
5830 ;; "a\nb" + "\nc\n"
5831 (let ((incomplete-line-info (cons 'incomplete-line "")))
5832 (anything-output-filter--collect-candidates
5833 '("a" "b") incomplete-line-info)
5834 (anything-output-filter--collect-candidates
5835 '("" "c" "") incomplete-line-info)))
5839 (provide 'anything)
5840 ;; How to save (DO NOT REMOVE!!)
5841 ;; (progn (magit-push) (emacswiki-post "anything.el"))
5842 ;;; anything.el ends here