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