root/dotfiles/emacs/oinume/.emacs.d/elisp/anything.el @ 13627

Revision 13627, 59.1 kB (checked in by oinume, 6 years ago)

dotfiles/emacs/oinume

  • Property svn:executable set to *
Line 
1;;; anything.el --- open anything
2
3;; Copyright (C) 2007  Tamas Patrovics
4
5;; This file is free software; you can redistribute it and/or modify
6;; it under the terms of the GNU General Public License as published by
7;; the Free Software Foundation; either version 2, or (at your option)
8;; any later version.
9
10;; This file is distributed in the hope that it will be useful,
11;; but WITHOUT ANY WARRANTY; without even the implied warranty of
12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
13;; GNU General Public License for more details.
14
15;; You should have received a copy of the GNU General Public License
16;; along with GNU Emacs; see the file COPYING.  If not, write to the
17;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
18;; Boston, MA 02110-1301, USA.
19
20;;; Commentary:
21
22;;
23;; Start with M-x anything, narrow the list by typing some pattern,
24;; select with up/down/pgup/pgdown, choose with enter, left/right
25;; moves between sources. With TAB actions can be selected if the
26;; selected candidate has more than one possible action.
27;;
28;; Note that anything.el provides only the framework and some example
29;; configurations for demonstration purposes. See anything-config.el
30;; for practical, polished, easy to use configurations which can be
31;; used to assemble a custom personalized configuration.
32;;
33;;
34;; Tested on Emacs 22.
35;;
36;;
37;; Thanks to Vagn Johansen for ideas.
38;; Thanks to Stefan Kamphausen for fixes and XEmacs support.
39;; Thanks to Tassilo Horn for fixes.
40;; Thanks to Drew Adams for various fixes (frame, isearch, customization, etc.)
41;;
42
43
44;; TODO:
45;;
46;;   - process status indication
47;;
48;;   - results from async sources should appear in the order they are
49;;     specified in anything-sources
50;;
51;;   - async sources doesn't honor digit-shortcut-count
52;;
53;;   - anything-candidate-number-limit can't be nil everywhere
54;;
55
56(require 'cl)
57
58;; User Configuration
59
60;; This is only an example. Customize it to your own taste!
61(defvar anything-sources `(((name . "Buffers")
62                            (candidates
63                             . (lambda ()
64                                 (remove-if (lambda (name)
65                                              (or (equal name anything-buffer)
66                                                  (eq ?\  (aref name 0))))
67                                            (mapcar 'buffer-name (buffer-list)))))
68                            (type . buffer))
69
70                           ((name . "File Name History")
71                            (candidates . file-name-history)
72                            (match (lambda (candidate)
73                                     ;; list basename matches first
74                                     (string-match
75                                      anything-pattern
76                                      (file-name-nondirectory candidate)))
77
78                                   (lambda (candidate)                                     
79                                     ;; and then directory part matches
80                                     (let ((dir (file-name-directory candidate)))
81                                       (if dir
82                                           (string-match anything-pattern dir)))))
83                            (type . file))
84
85                           ((name . "Files from Current Directory")
86                            (init . (lambda ()
87                                      (setq anything-default-directory
88                                            default-directory)))
89                            (candidates . (lambda ()
90                                            (directory-files
91                                             anything-default-directory)))
92                            (type . file))
93
94                           ((name . "Manual Pages")
95                            (candidates . ,(progn
96                                             ;; XEmacs doesn't have a woman :)
97                                             (condition-case nil
98                                                 (progn
99                                                   (require 'woman)
100                                                   (woman-file-name "")
101                                                   (sort (mapcar 'car
102                                                                 woman-topic-all-completions)
103                                                         'string-lessp))
104                                               (error nil))))
105                            (action . (("Open Manual Page" . woman)))
106                            (requires-pattern . 2))
107
108                           ((name . "Complex Command History")
109                            (candidates . (lambda ()
110                                            (mapcar 'prin1-to-string
111                                                    command-history)))
112                            (action . (("Repeat Complex Command" .
113                                        (lambda (c)
114                                          (eval (read c))))))
115                            (delayed)))
116  "The source of candidates for anything.
117
118Attributes:
119
120- name (mandatory)
121
122  The name of the source. It is also the heading which appears
123  above the list of matches from the source. Must be unique.
124
125- candidates (mandatory)
126
127  Specifies how to retrieve candidates from the source. It can
128  either be a variable name, a function called with no parameters
129  or the actual list of candidates.
130
131  The list must be a list of strings, so it's the responsibility
132  of the source to convert candidates to strings if necessary.
133
134  If the candidates have to be retrieved asynchronously (for
135  example, by an external command which takes a while to run)
136  then the function should start the external command
137  asynchronously and return the associated process object.
138  Anything will take care of managing the process (receiving the
139  output from it, killing it if necessary, etc.). The process
140  should return candidates matching the current pattern (see
141  variable `anything-pattern'.)
142
143  Note that currently results from asynchronous sources appear
144  last in the anything buffer regardless of their position in
145  `anything-sources'.
146
147- action (mandatory if type attribute is not provided)
148
149  It is a list of (DISPLAY . FUNCTION) pairs. FUNCTION is called
150  with one parameter: the selected candidate.
151
152  An action other than the default can be chosen from this list
153  of actions for the currently selected candidate (by default
154  with TAB). The DISPLAY string is shown in the completions
155  buffer and the FUNCTION is invoked when an action is
156  selected. The first action of the list is the default.
157
158- type (optional if action attribute is provided)
159
160  Indicates the type of the items the source returns.
161
162  Merge attributes not specified in the source itself from
163  `anything-type-attributes'.
164
165- init (optional)
166
167  Function called with no parameters when anything is started. It
168  is useful for collecting current state information which can be
169  used to create the list of candidates later.
170
171  For example, if a source needs to work with the current
172  directory then it can store its value here, because later
173  anything does its job in the minibuffer and in the
174  `anything-buffer' and the current directory can be different
175  there.
176
177- match (optional)
178
179  List of functions called with one parameter: a candidate. The
180  function should return non-nil if the candidate matches the
181  current pattern (see variable `anything-pattern').
182
183  This attribute allows the source to override the default
184  pattern matching based on `string-match'. It can be used, for
185  example, to implement a source for file names and do the
186  pattern matching on the basename of files, since it's more
187  likely one is typing part of the basename when searching for a
188  file, instead of some string anywhere else in its path.
189
190  If the list contains more than one function then the list of
191  matching candidates from the source is constructed by appending
192  the results after invoking the first function on all the
193  potential candidates, then the next function, and so on. The
194  matching candidates supplied by the first function appear first
195  in the list of results and then results from the other
196  functions, respectively.
197
198  This attribute has no effect for asynchronous sources (see
199  attribute `candidates'), since they perform pattern matching
200  themselves.
201
202- candidate-transformer (optional)
203
204  It's a function called with one argument when the completion
205  list from the source is built. The argument is the list of
206  candidates retrieved from the source. The function should
207  return a transformed list of candidates which will be used for
208  the actual completion.
209
210  This can be used to transform or remove items from the list of
211  candidates.
212
213  The function can also substitute candidates in the returned
214  list with (DISPLAY . REAL) pairs. In this case the DISPLAY
215  string is shown in the Anything buffer, but the REAL one is
216  used as action argument when the candidate is selected. This
217  allows a more readable presentation for candidates which would
218  otherwise be, for example, too long or have a common part
219  shared with other candidates which can be safely replaced with
220  an abbreviated string for display purposes.
221
222  Note that if the (DISPLAY . REAL) form is used then pattern
223  matching is done on the displayed string, not on the real
224  value.
225
226- filtered-candidate-transformer (optional)
227
228  It has the same format as `candidate-transformer', except the
229  function is called with two parameters: the candidate list and
230  the source.
231
232  This transformer is run on the candidate list which is already
233  filtered by the current pattern. While `candidate-transformer'
234  is run only once, it is run every time the input pattern is
235  changed.
236
237  It can be used to transform the candidate list dynamically, for
238  example, based on the current pattern.
239
240  In some cases it may also be more efficent to perform candidate
241  transformation here, instead of with `candidate-transformer'
242  even if this transformation is done every time the pattern is
243  changed.  For example, if a candidate set is very large then
244  `candidate-transformer' transforms every candidate while only
245  some of them will actually be dislpayed due to the limit
246  imposed by `anything-candidate-number-limit'.
247
248  Note that `candidate-transformer' is run already, so the given
249  transformer function should also be able to handle candidates
250  with (DISPLAY . REAL) format.
251
252  This option has no effect for asynchronous sources. (Not yet,
253  at least.
254
255- action-transformer (optional)
256
257  It's a function called with two arguments when the action list
258  from the source is assembled. The first argument is the list of
259  actions, the second is the current selection.
260
261  The function should return a transformed action list.
262
263  This can be used to customize the list of actions based on the
264  currently selected candidate.
265
266- delayed (optional)
267
268  Candidates from the source are shown only if the user stops
269  typing and is idle for `anything-idle-delay' seconds.
270
271- volatile (optional)
272
273  Indicates the source assembles the candidate list dynamically,
274  so it shouldn't be cached within a single Anything
275  invocation. It is only applicable to synchronous sources,
276  because asynchronous sources are not cached.
277
278- requires-pattern (optional)
279
280  If present matches from the source are shown only if the
281  pattern is not empty. Optionally, it can have an integer
282  parameter specifying the required length of input which is
283  useful in case of sources with lots of candidates.")
284
285
286;; This value is only provided as an example. Customize it to your own
287;; taste!
288(defvar anything-type-attributes
289  '((file (action . (("Find File" . find-file)
290                     ("Delete File" . (lambda (file)
291                                        (if (y-or-n-p (format "Really delete file %s? "
292                                                              file))
293                                            (delete-file file)))))))
294    (buffer (action . (("Switch to Buffer" . switch-to-buffer)
295                       ("Pop to Buffer"    . pop-to-buffer)
296                       ("Display Buffer"   . display-buffer)
297                       ("Kill Buffer"      . kill-buffer)))))
298  "It's a list of (TYPE ATTRIBUTES ...). ATTRIBUTES are the same
299  as attributes for `anything-sources'. TYPE connects the value
300  to the appropriate sources in `anything-sources'.
301
302  This allows specifying common attributes for several
303  sources. For example, sources which provide files can specify
304  common attributes with a `file' type.")
305
306
307(defvar anything-enable-digit-shortcuts nil
308  "*If t then the first nine matches can be selected using
309  Ctrl+<number>.")
310
311
312(defvar anything-candidate-number-limit 50
313  "*Do not show more candidates than this limit from inidividual
314  sources. It is usually pointless to show hundreds of matches
315  when the pattern is empty, because it is much simpler to type a
316  few characters to narrow down the list of potential candidates.
317
318  Set it to nil if you don't want this limit.")
319
320
321(defvar anything-idle-delay 0.5
322  "*The user has to be idle for this many seconds, before
323  candidates from delayed sources are collected. This is useful
324  for sources involving heavy operations (like launching external
325  programs), so that candidates from the source are not retrieved
326  unnecessarily if the user keeps typing.
327
328  It also can be used to declutter the results anything displays,
329  so that results from certain sources are not shown with every
330  character typed, only if the user hesitates a bit.")
331
332
333(defvar anything-samewindow nil
334  "If t then Anything doesn't pop up a new window, it uses the
335current window to show the candidates.")
336
337
338(defvar anything-source-filter nil
339  "A list of source names to be displayed. Other sources won't
340appear in the search results. If nil then there is no filtering.
341See also `anything-set-source-filter'.")
342
343
344(defvar anything-map
345  (let ((map (copy-keymap minibuffer-local-map)))
346    (define-key map (kbd "<down>") 'anything-next-line)
347    (define-key map (kbd "<up>") 'anything-previous-line)
348    (define-key map (kbd "<prior>") 'anything-previous-page)
349    (define-key map (kbd "<next>") 'anything-next-page)
350    (define-key map (kbd "<right>") 'anything-next-source)
351    (define-key map (kbd "<left>") 'anything-previous-source)
352    (define-key map (kbd "<RET>") 'anything-exit-minibuffer)
353    (define-key map (kbd "C-1") 'anything-select-with-digit-shortcut)
354    (define-key map (kbd "C-2") 'anything-select-with-digit-shortcut)
355    (define-key map (kbd "C-3") 'anything-select-with-digit-shortcut)
356    (define-key map (kbd "C-4") 'anything-select-with-digit-shortcut)
357    (define-key map (kbd "C-5") 'anything-select-with-digit-shortcut)
358    (define-key map (kbd "C-6") 'anything-select-with-digit-shortcut)
359    (define-key map (kbd "C-7") 'anything-select-with-digit-shortcut)
360    (define-key map (kbd "C-8") 'anything-select-with-digit-shortcut)
361    (define-key map (kbd "C-9") 'anything-select-with-digit-shortcut)
362    (define-key map (kbd "C-i") 'anything-select-action)
363    ;; the defalias is needed because commands are bound by name when
364    ;; using iswitchb, so only commands having the prefix anything-
365    ;; get rebound
366    (defalias 'anything-previous-history-element 'previous-history-element)
367    ;; C-p is used instead of M-p, because anything uses ESC
368    ;; (currently hardcoded) for `anything-iswitchb-cancel-anything' and
369    ;; Emacs handles ESC and Meta as synonyms, so ESC overrides
370    ;; other commands with Meta prefix.
371    ;;
372    ;; Note that iswitchb uses M-p and M-n by default for history
373    ;; navigation, so you should bind C-p and C-n in
374    ;; `iswitchb-mode-map' if you use the history keys and don't want
375    ;; to use different keys for iswitchb while anything is not yet
376    ;; kicked in. These keys are not bound automatically by anything
377    ;; in `iswitchb-mode-map' because they (C-n at least) already have
378    ;; a standard iswitchb binding which you might be accustomed to.
379    (define-key map (kbd "C-p") 'anything-previous-history-element)
380    (defalias 'anything-next-history-element 'next-history-element)
381    (define-key map (kbd "C-n") 'anything-next-history-element)
382    ;; Binding M-s is used instead of C-s, because C-s has a binding in
383    ;; iswitchb.  You can rebind it, of course.
384    (define-key map (kbd "M-s") 'anything-isearch)
385    ;; unbind C-r to prevent problems during anything-isearch
386    (define-key map (kbd "C-r") nil)
387    map)
388  "Keymap for anything.")
389
390
391(defvar anything-isearch-map
392  (let ((map (copy-keymap (current-global-map))))
393    (define-key map (kbd "<return>") 'anything-isearch-default-action)
394    (define-key map (kbd "C-i") 'anything-isearch-select-action)
395    (define-key map (kbd "C-g") 'anything-isearch-cancel)
396    (define-key map (kbd "M-s") 'anything-isearch-again)
397    (define-key map (kbd "<backspace>") 'anything-isearch-delete)
398    ;; add printing chars
399    (let ((i 32))
400      (while (< i 256)
401        (define-key map (vector i) 'anything-isearch-printing-char)
402        (setq i (1+ i))))
403    map)
404  "Keymap for anything incremental search.")
405
406
407(defgroup anything nil
408  "Open anything." :prefix "anything-" :group 'convenience)
409
410(if (facep 'header-line)
411    (copy-face 'header-line 'anything-header)
412 
413  (defface anything-header
414    '((t (:bold t :underline t)))
415    "Face for header lines in the anything buffer." :group 'anything))
416
417(defvar anything-header-face 'anything-header
418  "Face for header lines in the anything buffer.")
419
420(defface anything-isearch-match '((t (:background "Yellow")))
421  "Face for isearch in the anything buffer." :group 'anything)
422
423(defvar anything-isearch-match-face 'anything-isearch-match
424  "Face for matches during incremental search.")
425
426(defvar anything-iswitchb-idle-delay 1
427  "Show anything completions if the user is idle that many
428  seconds after typing.")
429
430(defvar anything-iswitchb-dont-touch-iswithcb-keys nil
431  "If t then those commands are not bound from `anything-map'
432  under iswitchb which would override standard iswithcb keys.
433
434This allows an even more seamless integration with iswitchb for
435those who prefer using iswitchb bindings even if the anything
436completions buffer is popped up.
437
438Note that you can bind alternative keys for the same command in
439`anything-map', so that you can use different keys for anything
440under iswitchb. For example, I bind the character \ to
441`anything-exit-minibuffer' which key is just above Enter on my
442keyboard. This way I can switch buffers with Enter and choose
443anything completions with \.")
444
445;;----------------------------------------------------------------------
446;; Public functions
447;;----------------------------------------------------------------------
448;;
449;; These functions are the public API of Anything. See their
450;; documentation for more information.
451;;
452;; anything
453;; anything-iswitchb-setup
454;;
455;; anything-set-source-filter
456;;
457;;   This function sets a filter for anything sources and it may be
458;;   called while anything is running. It can be used to toggle
459;;   displaying of sources dinamically. For example, additional keys
460;;   can be bound into `anything-map' to display only the file-related
461;;   results if there are too many matches from other sources and
462;;   you're after files only:
463;;
464;;   Shift+F shows only file results from some sources:
465;;
466;;     (define-key anything-map "F" 'anything-my-show-files-only)
467;;     
468;;     (defun anything-my-show-files-only ()
469;;       (interactive)
470;;       (anything-set-source-filter '("File Name History"
471;;                                     "Files from Current Directory")))
472;;
473;;   Shift+A shows all results:
474;;
475;;     (define-key anything-map "A" 'anything-my-show-all)
476;;     
477;;     (defun anything-my-show-all ()
478;;       (interactive)
479;;       (anything-set-source-filter nil))
480;; 
481;; 
482;;   Note that you have to prefix the functions with anything- prefix,
483;;   otherwise they won't be bound when Anything is used under
484;;   Iswitchb. The -my- part is added to avoid collisions with
485;;   existing Anything function names.
486;; 
487
488;;----------------------------------------------------------------------
489
490(defconst anything-buffer "*anything*"
491  "Buffer showing completions.")
492
493(defvar anything-selection-overlay nil
494  "Overlay used to highlight the currently selected file.")
495
496(defvar anything-isearch-overlay nil
497  "Overlay used to highlight the current match during isearch.")
498
499(defvar anything-digit-overlays nil
500  "Overlays for digit shortcuts. See `anything-enable-digit-shortcuts'.")
501
502(defvar anything-candidate-cache nil
503  "Holds the available candidate withing a single anything invocation.")
504
505(defvar anything-pattern
506  "The input pattern used to update the anything buffer.")
507
508(defvar anything-input
509  "The input typed in the candidates panel.")
510
511(defvar anything-async-processes nil
512  "List of information about asynchronous processes managed by anything.")
513
514(defvar anything-digit-shortcut-count 0
515  "Number of digit shortcuts shown in the anything buffer.")
516
517(defvar anything-update-hook nil
518  "Run after the aything buffer was updated according the new
519  input pattern.")
520
521(defvar anything-saved-sources nil
522  "Saved value of the original `anything-sources' when the action
523  list is shown.")
524
525(defvar anything-saved-selection nil
526  "Saved value of the currently selected object when the action
527  list is shown.")
528
529(defvar anything-original-source-filter nil
530  "Original value of `anything-source-filter' before Anything was started.")
531
532
533(put 'anything 'timid-completion 'disabled)
534
535
536(defun anything-check-minibuffer-input ()
537  "Extract input string from the minibuffer and check if it needs
538to be handled."
539   (with-selected-window (minibuffer-window)
540     (anything-check-new-input (minibuffer-contents))))
541
542
543(defun anything-check-new-input (input)
544  "Check input string and update the anything buffer if
545necessary."
546  (unless (equal input anything-pattern)
547    (setq anything-pattern input)
548    (unless anything-saved-sources
549      (setq anything-input anything-pattern))
550    (anything-update)))
551
552
553(defun anything-update ()
554  "Update the list of matches in the anything buffer according to
555the current pattern."
556  (setq anything-digit-shortcut-count 0)
557  (anything-kill-async-processes)
558  (with-current-buffer anything-buffer
559    (erase-buffer)
560
561    (if anything-enable-digit-shortcuts
562        (dolist (overlay anything-digit-overlays)
563          (delete-overlay overlay)))
564
565    (let (delayed-sources)
566      (dolist (source (anything-get-sources))
567        (if (or (not anything-source-filter)
568                (member (assoc-default 'name source) anything-source-filter))
569          (if (equal anything-pattern "")
570              (unless (assoc 'requires-pattern source)
571                (if (assoc 'delayed source)
572                    (push source delayed-sources)
573                  (anything-process-source source)))
574
575            (let ((min-pattern-length (assoc-default 'requires-pattern source)))
576              (unless (and min-pattern-length
577                           (< (length anything-pattern) min-pattern-length))
578                (if (assoc 'delayed source)
579                    (push source delayed-sources)
580                  (anything-process-source source)))))))
581
582      (goto-char (point-min))
583      (run-hooks 'anything-update-hook)
584      (anything-next-line)
585
586      (anything-maybe-fit-frame)
587
588      (run-with-idle-timer (if (featurep 'xemacs)
589                               0.1
590                             0)
591                           nil
592                           'anything-process-delayed-sources
593                           delayed-sources))))
594
595
596(defun anything-get-sources ()
597  "Return `anything-sources' with the attributes from
598  `anything-type-attributes' merged in."
599  (mapcar (lambda (source)
600            (let ((type (assoc-default 'type source)))
601              (if type
602                  (append source (assoc-default type anything-type-attributes) nil)
603                source)))
604          anything-sources))
605
606
607(defun anything-process-source (source)
608  "Display matches from SOURCE according to its settings."
609  (let (matches)
610    (if (equal anything-pattern "")
611        (progn
612          (setq matches (anything-get-cached-candidates source))
613          (if (> (length matches) anything-candidate-number-limit)
614              (setq matches
615                    (subseq matches 0 anything-candidate-number-limit))))
616
617      (condition-case nil
618          (let ((item-count 0)
619                (functions (assoc-default 'match source))
620                exit)
621
622            (unless functions
623              (setq functions
624                    (list (lambda (candidate)
625                            (string-match anything-pattern candidate)))))
626
627            (dolist (function functions)
628              (let (newmatches)
629                (dolist (candidate (anything-get-cached-candidates source))
630                  (when (and (not (member candidate matches))
631                             (funcall function (if (listp candidate)
632                                                   (car candidate)
633                                                 candidate)))
634                    (push candidate newmatches)
635
636                    (when anything-candidate-number-limit
637                      (incf item-count)
638                      (when (= item-count anything-candidate-number-limit)
639                        (setq exit t)
640                        (return)))))
641
642                (setq matches (append matches (reverse newmatches)))
643
644                (if exit
645                    (return)))))
646
647        (invalid-regexp (setq matches nil))))
648
649    (let* ((transformer (assoc-default 'filtered-candidate-transformer source)))
650      (if transformer
651          (setq matches (funcall transformer matches source))))
652
653    (when matches
654      (anything-insert-header (assoc-default 'name source))
655
656      (dolist (match matches)
657        (when (and anything-enable-digit-shortcuts
658                   (not (eq anything-digit-shortcut-count 9)))
659          (move-overlay (nth anything-digit-shortcut-count
660                             anything-digit-overlays)
661                        (line-beginning-position)
662                        (line-beginning-position))
663          (incf anything-digit-shortcut-count))
664
665        (anything-insert-match match 'insert)))))
666
667
668(defun anything-insert-match (match insert-function)
669  "Insert MATCH into the anything buffer. If MATCH is a list then
670insert the string inteneded to appear on the display and store
671the real value in a text property."
672  (if (not (listp match))
673      (funcall insert-function match)
674
675    (funcall insert-function (car match))
676    (put-text-property (line-beginning-position) (line-end-position)
677                       'anything-realvalue (cdr match)))
678  (funcall insert-function "\n"))
679
680
681(defun anything-process-delayed-sources (delayed-sources)
682  "Process delayed sources if the user is idle for
683`anything-idle-delay' seconds."
684  (if (sit-for anything-idle-delay)
685      (with-current-buffer anything-buffer       
686        (save-excursion
687          (goto-char (point-max))
688          (dolist (source delayed-sources)
689            (anything-process-source source))
690
691          (when (and (not (equal (buffer-size) 0))
692                     ;; no selection yet
693                     (= (overlay-start anything-selection-overlay)
694                        (overlay-end anything-selection-overlay)))
695            (goto-char (point-min))
696            (run-hooks 'anything-update-hook)
697            (anything-next-line)))
698
699        (anything-maybe-fit-frame))))
700
701
702(defun anything ()
703  "Select anything."
704  (interactive)
705  (let ((frameconfig (current-frame-configuration)))
706    (add-hook 'post-command-hook 'anything-check-minibuffer-input)
707
708    (anything-initialize)
709
710    (if anything-samewindow
711        (switch-to-buffer anything-buffer)
712      (pop-to-buffer anything-buffer))
713
714    (unwind-protect
715        (progn
716          (anything-update)
717          (select-frame-set-input-focus (window-frame (minibuffer-window)))
718          (let ((minibuffer-local-map anything-map))
719            (read-string "pattern: ")))
720
721      (anything-cleanup)
722      (remove-hook 'post-command-hook 'anything-check-minibuffer-input)
723      (set-frame-configuration frameconfig)))
724
725  (anything-execute-selection-action))
726
727
728(defun anything-execute-selection-action ()
729  "If a candidate was selected then perform the associated
730action."
731  (let* ((selection (if anything-saved-sources
732                        ;; the action list is shown
733                        anything-saved-selection
734                      (anything-get-selection)))
735         (action (if anything-saved-sources
736                     ;; the action list is shown
737                     (anything-get-selection)
738                   (anything-get-action))))
739
740    (if (and (listp action)
741             (not (functionp action)))  ; lambda
742        ;; select the default action
743        (setq action (cdar action)))
744
745    (if (and selection action)
746        (funcall action selection))))
747
748
749(defun anything-get-selection ()
750  "Return the currently selected item or nil."
751  (unless (= (buffer-size (get-buffer anything-buffer)) 0)
752    (with-current-buffer anything-buffer
753      (let ((selection
754             (or (get-text-property (overlay-start
755                                     anything-selection-overlay)
756                                    'anything-realvalue)
757                 (buffer-substring-no-properties
758                  (overlay-start anything-selection-overlay)
759                  (1- (overlay-end anything-selection-overlay))))))
760        (unless (equal selection "")
761          selection)))))
762
763
764(defun anything-get-action ()
765  "Return the associated action for the selected candidate."
766  (unless (= (buffer-size (get-buffer anything-buffer)) 0)
767    (let* ((source (anything-get-current-source))
768           (actions (assoc-default 'action source)))
769
770      (let* ((transformer (assoc-default 'action-transformer source)))
771        (if transformer
772            (funcall transformer actions (anything-get-selection))
773          actions)))))
774
775
776(defun anything-select-action ()
777  "Select an action for the currently selected candidate."
778  (interactive)
779  (if anything-saved-sources
780      (error "Already showing the action list"))
781
782  (setq anything-saved-selection (anything-get-selection))
783  (unless anything-saved-selection
784    (error "Nothing is selected."))
785
786  (let ((actions (anything-get-action)))
787    (setq anything-source-filter nil)
788    (setq anything-saved-sources anything-sources)
789    (setq anything-sources `(((name . "Actions")
790                              (candidates . ,actions))))
791    (with-selected-window (minibuffer-window)
792      (delete-minibuffer-contents))
793    (setq anything-pattern 'dummy)      ; so that it differs from the
794                                        ; previous one
795    (anything-check-minibuffer-input)))
796
797
798(defun anything-initialize ()
799  "Initialize anything settings and set up the anything buffer."
800  ;; Call the init function for sources where appropriate
801  (dolist (source (anything-get-sources))
802    (let ((init (assoc-default 'init source)))
803      (if init
804          (funcall init))))
805
806  (setq anything-pattern "")
807  (setq anything-input "")
808  (setq anything-candidate-cache nil)
809  (setq anything-saved-sources nil)
810  (setq anything-original-source-filter anything-source-filter)
811
812  (with-current-buffer (get-buffer-create anything-buffer)
813    (setq cursor-type nil)
814    (setq mode-name "Anything"))
815
816  (if anything-selection-overlay
817      ;; make sure the overlay belongs to the anything buffer if
818      ;; it's newly created
819      (move-overlay anything-selection-overlay (point-min) (point-min)
820                    (get-buffer anything-buffer))
821
822    (setq anything-selection-overlay
823          (make-overlay (point-min) (point-min) (get-buffer anything-buffer)))
824    (overlay-put anything-selection-overlay 'face 'highlight))
825
826  (if anything-enable-digit-shortcuts
827      (unless anything-digit-overlays
828        (dotimes (i 9)
829          (push (make-overlay (point-min) (point-min)
830                              (get-buffer anything-buffer))
831                anything-digit-overlays)
832          (overlay-put (car anything-digit-overlays)
833                       'before-string (concat (int-to-string (1+ i)) " - ")))
834        (setq anything-digit-overlays (nreverse anything-digit-overlays)))
835
836    (when anything-digit-overlays
837      (dolist (overlay anything-digit-overlays)
838        (delete-overlay overlay))
839      (setq anything-digit-overlays nil))))
840
841
842(defun anything-cleanup ()
843  "Clean up the mess."
844  (setq anything-source-filter anything-original-source-filter)
845  (if anything-saved-sources
846      (setq anything-sources anything-saved-sources))
847  (with-current-buffer anything-buffer
848    (setq cursor-type t))
849  (bury-buffer anything-buffer)
850  (anything-kill-async-processes))
851
852
853(defun anything-previous-line ()
854  "Move selection to the previous line."
855  (interactive)
856  (anything-move-selection 'line 'previous))
857
858
859(defun anything-next-line ()
860  "Move selection to the next line."
861  (interactive)
862  (anything-move-selection 'line 'next))
863
864
865(defun anything-previous-page ()
866  "Move selection back with a pageful."
867  (interactive)
868  (anything-move-selection 'page 'previous))
869
870
871(defun anything-next-page ()
872  "Move selection forward with a pageful."
873  (interactive)
874  (anything-move-selection 'page 'next))
875
876
877(defun anything-previous-source ()
878  "Move selection to the previous source."
879  (interactive)
880  (anything-move-selection 'source 'previous))
881
882
883(defun anything-next-source ()
884  "Move selection to the next source."
885  (interactive)
886  (anything-move-selection 'source 'next))
887
888
889(defun anything-move-selection (unit direction)
890  "Move the selection marker to a new position determined by
891UNIT and DIRECTION."
892  (unless (or (= (buffer-size (get-buffer anything-buffer)) 0)
893              (not (get-buffer-window anything-buffer 'visible)))
894    (save-selected-window
895      (select-window (get-buffer-window anything-buffer 'visible))
896
897      (case unit
898        (line (forward-line (case direction
899                              (next 1)
900                              (previous -1)
901                              (t (error "Invalid direction.")))))
902
903        (page (case direction
904                (next (condition-case nil
905                          (scroll-up)
906                        (end-of-buffer (goto-char (point-max)))))
907                (previous (condition-case nil
908                              (scroll-down)
909                            (beginning-of-buffer (goto-char (point-min)))))
910                (t (error "Invalid direction."))))
911
912        (source (case direction
913                   (next (goto-char (or (anything-get-next-header-pos)
914                                        (point-min))))
915                   (previous (progn
916                               (forward-line -1)
917                               (if (bobp)
918                                   (goto-char (point-max))
919                                 (if (anything-pos-header-line-p)
920                                     (forward-line -1)
921                                   (forward-line 1)))
922                               (goto-char (anything-get-previous-header-pos))
923                               (forward-line 1)))
924                   (t (error "Invalid direction."))))
925
926        (t (error "Invalid unit.")))
927
928      (while (anything-pos-header-line-p)
929        (forward-line (if (and (eq direction 'previous)
930                               (not (eq (line-beginning-position)
931                                        (point-min))))
932                          -1
933                        1)))
934
935      (if (eobp)
936          (forward-line -1))
937
938      (anything-mark-current-line))))
939
940
941(defun anything-mark-current-line ()
942  "Move selection overlay to current line."
943  (move-overlay anything-selection-overlay
944                (line-beginning-position)
945                (1+ (line-end-position))))
946
947
948(defun anything-select-with-digit-shortcut ()
949  (interactive)
950  (if anything-enable-digit-shortcuts
951      (let* ((index (- (event-basic-type (elt (this-command-keys-vector) 0)) ?1))
952             (overlay (nth index anything-digit-overlays)))
953        (if (overlay-buffer overlay)
954            (save-selected-window
955              (select-window (get-buffer-window anything-buffer 'visible))         
956              (goto-char (overlay-start overlay))
957              (anything-mark-current-line)
958              (anything-exit-minibuffer))))))
959
960
961(defun anything-exit-minibuffer ()
962  "Select the current candidate by exiting the minibuffer."
963  (interactive)
964  (setq anything-iswitchb-candidate-selected (anything-get-selection))
965  (exit-minibuffer))
966
967
968(defun anything-get-current-source ()
969  "Return the source for the current selection."
970  (with-current-buffer anything-buffer
971      ;; This goto-char shouldn't be necessary, but point is moved to
972      ;; point-min somewhere else which shouldn't happen.
973      (goto-char (overlay-start anything-selection-overlay))
974      (let* ((header-pos (anything-get-previous-header-pos))
975             (source-name
976              (save-excursion
977                (assert header-pos)
978                (goto-char header-pos)
979                (buffer-substring-no-properties
980                 (line-beginning-position) (line-end-position)))))
981        (some (lambda (source)
982                (if (equal (assoc-default 'name source)
983                           source-name)
984                    source))
985              (anything-get-sources)))))
986
987
988(defun anything-get-next-header-pos ()
989  "Return the position of the next header from point."
990  (next-single-property-change (point) 'anything-header))
991
992
993(defun anything-get-previous-header-pos ()
994  "Return the position of the previous header from point"
995  (previous-single-property-change (point) 'anything-header))
996
997
998(defun anything-pos-header-line-p ()
999  "Return t if the current line is a header line."
1000  (or (get-text-property (line-beginning-position) 'anything-header)
1001      (get-text-property (line-beginning-position) 'anything-header-separator)))
1002
1003
1004(defun anything-get-candidates (source)
1005  "Retrieve and return the list of candidates from
1006SOURCE."
1007  (let* ((candidate-source (assoc-default 'candidates source))
1008         (candidates
1009          (if (functionp candidate-source)
1010              (funcall candidate-source)
1011            (if (listp candidate-source)
1012                candidate-source
1013              (if (and (symbolp candidate-source)
1014                       (boundp candidate-source))
1015                  (symbol-value candidate-source)
1016                (error (concat "Candidates must either be a function, "
1017                               " a variable or a list: %s")
1018                       candidate-source))))))
1019    (if (processp candidates)
1020        candidates
1021      (anything-transform-candidates candidates source))))
1022         
1023
1024(defun anything-transform-candidates (candidates source)
1025  "Transform CANDIDATES according to candidate transformers."
1026  (let* ((transformer (assoc-default 'candidate-transformer source)))
1027    (if transformer
1028        (funcall transformer candidates)
1029      candidates)))
1030
1031
1032(defun anything-get-cached-candidates (source)
1033  "Return the cached value of candidates for SOURCE.
1034Cache the candidates if there is not yet a cached value."
1035  (let* ((name (assoc-default 'name source))
1036         (candidate-cache (assoc name anything-candidate-cache))
1037         candidates)
1038
1039    (if candidate-cache
1040        (setq candidates (cdr candidate-cache))
1041
1042      (setq candidates (anything-get-candidates source))
1043
1044      (if (processp candidates)
1045          (progn
1046            (push (cons candidates
1047                        (append source
1048                                (list (cons 'item-count 0)
1049                                      (cons 'incomplete-line ""))))
1050                  anything-async-processes)
1051            (set-process-filter candidates 'anything-output-filter)
1052            (setq candidates nil))
1053
1054        (unless (assoc 'volatile source)
1055          (setq candidate-cache (cons name candidates))
1056          (push candidate-cache anything-candidate-cache))))
1057
1058    candidates))
1059
1060
1061(defun anything-output-filter (process string)
1062  "Process output from PROCESS."
1063  (let* ((process-assoc (assoc process anything-async-processes))
1064         (process-info (cdr process-assoc))
1065         (insertion-marker (assoc-default 'insertion-marker process-info))
1066         (incomplete-line-info (assoc 'incomplete-line process-info))
1067         (item-count-info (assoc 'item-count process-info)))
1068
1069    (with-current-buffer anything-buffer
1070      (save-excursion
1071        (if insertion-marker
1072            (goto-char insertion-marker)
1073       
1074          (goto-char (point-max))
1075          (anything-insert-header (assoc-default 'name process-info))
1076          (setcdr process-assoc
1077                  (append process-info `((insertion-marker . ,(point-marker))))))
1078
1079        (let ((lines (split-string string "\n"))
1080              candidates)
1081          (while lines
1082            (if (not (cdr lines))
1083                ;; store last incomplete line until new output arrives
1084                (setcdr incomplete-line-info (car lines))
1085
1086              (if (cdr incomplete-line-info)
1087                  (progn
1088                    (push (concat (cdr incomplete-line-info) (car lines))
1089                          candidates)
1090                    (setcdr incomplete-line-info nil))
1091
1092              (push (car lines) candidates)))
1093                 
1094            (pop lines))
1095
1096          (setq candidates (reverse candidates))
1097          (dolist (candidate (anything-transform-candidates candidates process-info))
1098            (anything-insert-match candidate 'insert-before-markers)
1099            (incf (cdr item-count-info))
1100            (when (>= (cdr item-count-info) anything-candidate-number-limit)
1101              (anything-kill-async-process process)
1102              (return)))))
1103
1104      (anything-maybe-fit-frame)
1105
1106      (run-hooks 'anything-update-hook)
1107
1108      (if (bobp)
1109          (anything-next-line)
1110
1111        (save-selected-window
1112          (select-window (get-buffer-window anything-buffer 'visible))
1113          (anything-mark-current-line))))))
1114
1115
1116(defun anything-kill-async-processes ()
1117  "Kill all known asynchronous processes according to
1118`anything-async-processes'."
1119    "Kill locate process."
1120    (dolist (process-info anything-async-processes)
1121      (anything-kill-async-process (car process-info)))
1122    (setq anything-async-processes nil))
1123
1124
1125(defun anything-kill-async-process (process)
1126  "Kill PROCESS and detach the associated functions."
1127  (set-process-filter process nil)
1128  (delete-process process))
1129 
1130
1131(defun anything-insert-header (name)
1132  "Insert header of source NAME into the anything buffer."
1133  (unless (bobp)
1134    (let ((start (point)))
1135      (insert "\n")
1136      (put-text-property start (point) 'anything-header-separator t)))
1137
1138  (let ((start (point)))
1139    (insert name)
1140    (put-text-property (line-beginning-position)
1141                       (line-end-position) 'anything-header t)
1142    (insert "\n")
1143    (put-text-property start (point) 'face anything-header-face)))
1144
1145
1146(defun anything-set-source-filter (sources)
1147  "Sets the value of `anything-source-filter' and updates the list of results."
1148  (setq anything-source-filter sources)
1149  (anything-update))
1150
1151
1152(defun anything-maybe-fit-frame ()
1153   "Fit anything frame to its buffer, and put it at top right of display.
1154 To inhibit fitting, set `fit-frame-inhibit-fitting-flag' to t.
1155 You can set user options `fit-frame-max-width-percent' and
1156 `fit-frame-max-height-percent' to control max frame size."
1157   (when (and (require 'fit-frame nil t)
1158              (boundp 'fit-frame-inhibit-fitting-flag)
1159              (not fit-frame-inhibit-fitting-flag)
1160              (get-buffer-window anything-buffer 'visible))
1161     (with-selected-window (get-buffer-window anything-buffer 'visible)
1162       (fit-frame nil nil nil t)
1163       (modify-frame-parameters
1164        (selected-frame)
1165        `((left . ,(- (x-display-pixel-width) (+ (frame-pixel-width) 7)))
1166          (top . 0)))))) ; The (top . 0) shouldn't be necessary (Emacs bug).
1167
1168
1169;;---------------------------------------------------------------------
1170;; Incremental search within results
1171;;----------------------------------------------------------------------
1172
1173(defvar anything-isearch-original-global-map nil
1174  "Original global map before Anything isearch is started.")
1175
1176(defvar anything-isearch-original-message-timeout nil
1177  "Original message timeout before Anything isearch is started.")
1178
1179(defvar anything-isearch-pattern nil
1180  "The current isearch pattern.")
1181
1182(defvar anything-isearch-message-suffix ""
1183  "Message suffix indicating the current state of the search.")
1184
1185(defvar anything-isearch-original-point nil
1186  "Original position of point before isearch is started.")
1187
1188(defvar anything-isearch-original-window nil
1189  "Original selected window before isearch is started.")
1190
1191(defvar anything-isearch-original-cursor-in-non-selected-windows nil
1192  "Original value of cursor-in-non-selected-windows before isearch is started.")
1193
1194(defvar anything-isearch-original-post-command-hook nil
1195  "Original value of post-command-hook before isearch is started.")
1196
1197(defvar anything-isearch-match-positions nil
1198  "Stack of positions of matches or non-matches.
1199
1200It's a list of plists with two properties: `event', the last user
1201 event, `start', the start position of the current match, and
1202 `pos', the position of point after that event.
1203
1204The value of `event' can be the following symbols: `char' if a
1205character was typed, `error' if a non-matching character was
1206typed, `search' if a forward search had to be done after a
1207character, and `search-again' if a search was done for the next
1208occurrence of the current pattern.")
1209
1210(defvar anything-isearch-match-start nil
1211  "Start position of the current match.")
1212
1213
1214(defun anything-isearch ()
1215  "Start incremental search within results."
1216  (interactive)
1217  (if (eq (buffer-size (get-buffer anything-buffer)) 0)
1218      (message "There are no results.")
1219
1220    (setq anything-isearch-original-message-timeout minibuffer-message-timeout)
1221    (setq minibuffer-message-timeout nil)
1222
1223    (setq anything-isearch-original-global-map global-map)
1224
1225    (condition-case nil
1226        (progn
1227          (setq anything-isearch-original-window (selected-window))
1228          (select-window (get-buffer-window anything-buffer 'visible))
1229          (setq cursor-type t)
1230
1231          (setq anything-isearch-original-post-command-hook
1232                (default-value 'post-command-hook))
1233          (setq-default post-command-hook nil)
1234          (add-hook 'post-command-hook 'anything-isearch-post-command)
1235
1236          (use-global-map anything-isearch-map)
1237          (setq overriding-terminal-local-map anything-isearch-map)
1238
1239          (setq anything-isearch-pattern "")
1240
1241          (setq anything-isearch-original-cursor-in-non-selected-windows
1242                cursor-in-non-selected-windows)
1243          (setq cursor-in-non-selected-windows nil)
1244
1245          (setq anything-isearch-original-point (point-marker))
1246          (goto-char (point-min))
1247          (forward-line)
1248          (anything-mark-current-line)
1249
1250          (setq anything-isearch-match-positions nil)
1251          (setq anything-isearch-match-start (point-marker))
1252
1253          (if anything-isearch-overlay
1254              ;; make sure the overlay belongs to the anything buffer
1255              (move-overlay anything-isearch-overlay (point-min) (point-min)
1256                            (get-buffer anything-buffer))
1257
1258            (setq anything-isearch-overlay (make-overlay (point-min) (point-min)))
1259            (overlay-put anything-isearch-overlay 'face anything-isearch-match-face))
1260
1261          (setq anything-isearch-message-suffix
1262                (substitute-command-keys "cancel with \\[anything-isearch-cancel]")))
1263
1264      (error (anything-isearch-cleanup)))))
1265
1266
1267(defun anything-isearch-post-command ()
1268  "Print the current pattern after every command."
1269  (anything-isearch-message)
1270  (when (get-buffer-window anything-buffer 'visible)
1271    (with-selected-window (get-buffer-window anything-buffer 'visible)
1272      (move-overlay anything-isearch-overlay anything-isearch-match-start (point)
1273                    (get-buffer anything-buffer)))))
1274
1275
1276(defun anything-isearch-printing-char ()
1277  "Add printing char to the pattern."
1278  (interactive)
1279  (let ((char (char-to-string last-command-char)))
1280    (setq anything-isearch-pattern (concat anything-isearch-pattern char))
1281
1282    (with-selected-window (get-buffer-window anything-buffer 'visible)
1283      (if (looking-at char)
1284          (progn
1285            (push (list 'event 'char
1286                        'start anything-isearch-match-start
1287                        'pos (point-marker))
1288                  anything-isearch-match-positions)
1289            (forward-char))
1290
1291        (let ((start (point)))
1292          (while (and (re-search-forward anything-isearch-pattern nil t)
1293                      (anything-pos-header-line-p)))
1294          (if (or (anything-pos-header-line-p)
1295                  (eq start (point)))
1296              (progn
1297                (goto-char start)
1298                (push (list 'event 'error
1299                            'start anything-isearch-match-start
1300                            'pos (point-marker))
1301                      anything-isearch-match-positions))
1302
1303            (push (list 'event 'search
1304                        'start anything-isearch-match-start
1305                        'pos (copy-marker start))
1306                  anything-isearch-match-positions)
1307            (setq anything-isearch-match-start (copy-marker (match-beginning 0))))))
1308 
1309      (anything-mark-current-line))))
1310
1311
1312(defun anything-isearch-again ()
1313  "Search again for the current pattern"
1314  (interactive)
1315  (if (equal anything-isearch-pattern "")
1316      (setq anything-isearch-message-suffix "no pattern yet")
1317
1318    (with-selected-window (get-buffer-window anything-buffer 'visible)
1319      (let ((start (point)))
1320        (while (and (re-search-forward anything-isearch-pattern nil t)
1321                    (anything-pos-header-line-p)))
1322        (if (or (anything-pos-header-line-p)
1323                (eq start (point)))
1324            (progn
1325              (goto-char start)
1326              (unless (eq 'error (plist-get (car anything-isearch-match-positions)
1327                                            'event))
1328                (setq anything-isearch-message-suffix "no more matches")))
1329
1330          (push (list 'event 'search-again
1331                      'start anything-isearch-match-start
1332                      'pos (copy-marker start))
1333                anything-isearch-match-positions)
1334          (setq anything-isearch-match-start (copy-marker (match-beginning 0)))
1335
1336          (anything-mark-current-line))))))
1337
1338
1339(defun anything-isearch-delete ()
1340  "Undo last event."
1341  (interactive)
1342  (unless (equal anything-isearch-pattern "")
1343    (let ((last (pop anything-isearch-match-positions)))
1344      (unless (eq 'search-again (plist-get last 'event))
1345        (setq anything-isearch-pattern
1346              (substring anything-isearch-pattern 0 -1)))
1347
1348      (with-selected-window (get-buffer-window anything-buffer 'visible)     
1349        (goto-char (plist-get last 'pos))
1350        (setq anything-isearch-match-start (plist-get last 'start))
1351        (anything-mark-current-line)))))
1352
1353
1354(defun anything-isearch-default-action ()
1355  "Execute the default action for the selected candidate."
1356  (interactive)
1357  (anything-isearch-cleanup)
1358  (with-current-buffer anything-buffer (anything-exit-minibuffer)))
1359
1360
1361(defun anything-isearch-select-action ()
1362  "Choose an action for the selected candidate."
1363  (interactive)
1364  (anything-isearch-cleanup)
1365  (with-selected-window (get-buffer-window anything-buffer 'visible)
1366    (anything-select-action)))
1367
1368
1369(defun anything-isearch-cancel ()
1370  "Cancel Anything isearch."
1371  (interactive)
1372  (anything-isearch-cleanup)
1373  (when (get-buffer-window anything-buffer 'visible)
1374    (with-selected-window (get-buffer-window anything-buffer 'visible)
1375      (goto-char anything-isearch-original-point)
1376      (anything-mark-current-line))))
1377
1378
1379(defun anything-isearch-cleanup ()
1380  "Clean up the mess."
1381  (setq minibuffer-message-timeout anything-isearch-original-message-timeout)
1382  (with-current-buffer anything-buffer
1383    (setq overriding-terminal-local-map nil)
1384    (setq cursor-type nil)
1385    (setq cursor-in-non-selected-windows
1386          anything-isearch-original-cursor-in-non-selected-windows))
1387  (when anything-isearch-original-window
1388    (select-window anything-isearch-original-window))
1389
1390  (use-global-map anything-isearch-original-global-map)
1391  (setq-default post-command-hook anything-isearch-original-post-command-hook)
1392  (when (overlayp anything-isearch-overlay)
1393    (delete-overlay anything-isearch-overlay)))
1394
1395
1396(defun anything-isearch-message ()
1397  "Print prompt."
1398  (if (and (equal anything-isearch-message-suffix "")
1399           (eq (plist-get (car anything-isearch-match-positions) 'event)
1400               'error))
1401      (setq anything-isearch-message-suffix "failing"))
1402
1403  (unless (equal anything-isearch-message-suffix "")
1404    (setq anything-isearch-message-suffix
1405          (concat " [" anything-isearch-message-suffix "]")))
1406
1407  (message (concat "Search within results: "
1408                   anything-isearch-pattern
1409                   anything-isearch-message-suffix))
1410
1411  (setq anything-isearch-message-suffix ""))
1412
1413
1414;;---------------------------------------------------------------------
1415;; Iswitchb integration
1416;;----------------------------------------------------------------------
1417
1418(defvar anything-iswitchb-candidate-selected nil
1419  "Indicates whether an anything candidate is selected from iswitchb.")
1420
1421(defvar anything-iswitchb-frame-configuration nil
1422  "Saved frame configuration, before anything buffer was displayed.")
1423
1424(defvar anything-iswitchb-saved-keys nil
1425  "The original in iswitchb before binding anything keys.")
1426
1427
1428(defun anything-iswitchb-setup ()
1429  "Integrate anything completion into iswitchb.
1430
1431If the user is idle for `anything-iswitchb-idle-delay' seconds
1432after typing something into iswitchb then anything candidates are
1433shown for the current iswitchb input.
1434
1435ESC cancels anything completion and returns to normal iswitchb."
1436  (interactive)
1437
1438  (require 'iswitchb)
1439
1440  ;; disable timid completion during iswitchb
1441  (put 'iswitchb-buffer 'timid-completion 'disabled)
1442  (add-hook 'minibuffer-setup-hook  'anything-iswitchb-minibuffer-setup)
1443
1444  (defadvice iswitchb-visit-buffer
1445    (around anything-iswitchb-visit-buffer activate)
1446    (if anything-iswitchb-candidate-selected
1447        (anything-execute-selection-action)
1448      ad-do-it))
1449
1450  (defadvice iswitchb-possible-new-buffer
1451    (around anything-iswitchb-possible-new-buffer activate)
1452    (if anything-iswitchb-candidate-selected
1453        (anything-execute-selection-action)
1454      ad-do-it))
1455
1456  (message "Iswitchb integration is activated."))
1457
1458
1459(defun anything-iswitchb-minibuffer-setup ()
1460  (when (eq this-command 'iswitchb-buffer)
1461    (add-hook 'minibuffer-exit-hook  'anything-iswitchb-minibuffer-exit)
1462
1463    (setq anything-iswitchb-frame-configuration nil)
1464    (setq anything-iswitchb-candidate-selected nil)
1465    (add-hook 'anything-update-hook 'anything-iswitchb-handle-update)
1466
1467    (anything-initialize)
1468   
1469    (add-hook 'post-command-hook 'anything-iswitchb-check-input)))
1470
1471
1472(defun anything-iswitchb-minibuffer-exit ()
1473  (remove-hook 'minibuffer-exit-hook  'anything-iswitchb-minibuffer-exit)
1474  (remove-hook 'post-command-hook 'anything-iswitchb-check-input)
1475  (remove-hook 'anything-update-hook 'anything-iswitchb-handle-update)
1476
1477  (anything-cleanup)
1478
1479  (when anything-iswitchb-frame-configuration
1480    (set-frame-configuration anything-iswitchb-frame-configuration)
1481    (setq anything-iswitchb-frame-configuration nil)))
1482
1483
1484(defun anything-iswitchb-check-input ()
1485  "Extract iswitchb input and check if it needs to be handled."
1486  (if (or anything-iswitchb-frame-configuration
1487          (sit-for anything-iswitchb-idle-delay))
1488      (anything-check-new-input iswitchb-text)))
1489
1490
1491(defun anything-iswitchb-handle-update ()
1492  "Pop up the anything buffer if it's not empty and it's not
1493shown yet and bind anything commands in iswitchb."
1494  (unless (or (equal (buffer-size (get-buffer anything-buffer)) 0)
1495              anything-iswitchb-frame-configuration)
1496    (setq anything-iswitchb-frame-configuration (current-frame-configuration))
1497
1498    (save-selected-window
1499      (if (not anything-samewindow)
1500          (pop-to-buffer anything-buffer)
1501
1502        (select-window (get-lru-window))
1503        (switch-to-buffer anything-buffer)))
1504
1505    (with-current-buffer (window-buffer (active-minibuffer-window))
1506      (let* ((anything-prefix "anything-")
1507             (prefix-length (length anything-prefix))
1508             (commands
1509              (delete-dups
1510               (remove-if 'null
1511                          (mapcar
1512                           (lambda (binding)
1513                             (let ((command (cdr binding)))
1514                               (when (and (symbolp command)
1515                                          (eq (compare-strings
1516                                               anything-prefix
1517                                               0 prefix-length
1518                                               (symbol-name command)
1519                                               0 prefix-length)
1520                                              t))
1521                                 command)))
1522                           (cdr anything-map)))))
1523             (bindings (mapcar (lambda (command)
1524                                 (cons command
1525                                       (where-is-internal command anything-map)))
1526                               commands)))
1527
1528        (push (list 'anything-iswitchb-cancel-anything (kbd "<ESC>"))
1529              bindings)
1530
1531        (setq anything-iswitchb-saved-keys nil)
1532
1533      (let* ((iswitchb-prefix "iswitchb-")
1534             (prefix-length (length iswitchb-prefix)))
1535        (dolist (binding bindings)
1536          (dolist (key (cdr binding))
1537            (let ((old-command (lookup-key (current-local-map) key)))
1538              (unless (and anything-iswitchb-dont-touch-iswithcb-keys
1539                           (symbolp old-command)
1540                           (eq (compare-strings iswitchb-prefix
1541                                                0 prefix-length
1542                                                (symbol-name old-command)
1543                                                0 prefix-length)
1544                               t))
1545                (push (cons key old-command)
1546                      anything-iswitchb-saved-keys)
1547                (define-key (current-local-map) key (car binding)))))))))))
1548
1549
1550(defun anything-iswitchb-cancel-anything ()
1551  "Cancel anything completion and return to standard iswitchb."
1552  (interactive)
1553  (save-excursion
1554    (dolist (binding anything-iswitchb-saved-keys)
1555      (define-key (current-local-map) (car binding) (cdr binding)))
1556    (anything-iswitchb-minibuffer-exit)))
1557
1558
1559;;----------------------------------------------------------------------
1560;; XEmacs compatibility
1561;;----------------------------------------------------------------------
1562
1563;; Copied assoc-default from XEmacs version 21.5.12
1564(unless (fboundp 'assoc-default)
1565  (defun assoc-default (key alist &optional test default)
1566    "Find object KEY in a pseudo-alist ALIST.
1567ALIST is a list of conses or objects.  Each element (or the element's car,
1568if it is a cons) is compared with KEY by evaluating (TEST (car elt) KEY).
1569If that is non-nil, the element matches;
1570then `assoc-default' returns the element's cdr, if it is a cons,
1571or DEFAULT if the element is not a cons.
1572
1573If no element matches, the value is nil.
1574If TEST is omitted or nil, `equal' is used."
1575    (let (found (tail alist) value)
1576      (while (and tail (not found))
1577        (let ((elt (car tail)))
1578          (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
1579            (setq found t value (if (consp elt) (cdr elt) default))))
1580        (setq tail (cdr tail)))
1581      value)))
1582
1583;; Function not available in XEmacs,
1584(unless (fboundp 'minibuffer-contents)
1585  (defun minibuffer-contents ()
1586    "Return the user input in a minbuffer as a string.
1587The current buffer must be a minibuffer."
1588    (field-string (point-max)))
1589
1590  (defun delete-minibuffer-contents  ()
1591    "Delete all user input in a minibuffer.
1592The current buffer must be a minibuffer."
1593    (delete-field (point-max))))
1594
1595
1596(provide 'anything)
1597;;; anything.el ends here
Note: See TracBrowser for help on using the browser.