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