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