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