1 ;;; anything-config.el --- Predefined configurations for `anything.el'
3 ;; Filename: anything-config.el
5 ;; Description: Predefined configurations for `anything.el'
6 ;; Author: Tassilo Horn <tassilo@member.fsf.org>
7 ;; Maintainer: Tassilo Horn <tassilo@member.fsf.org>
8 ;; rubikitch <rubikitch@ruby-lang.org>
9 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
10 ;; Copyright (C) 2007 ~ 2009, Tassilo Horn, all rights reserved.
11 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
12 ;; Copyright (C) 2009, rubikitch, all rights reserved.
13 ;; Copyright (C) 2009, Thierry Volpiatto, all rights reserved.
14 ;; Created: 2009-02-16 21:38:23
16 ;; URL: http://www.emacswiki.org/emacs/download/anything-config.el
17 ;; Keywords: anything, anything-config
18 ;; Compatibility: GNU Emacs 22 ~ 23
20 ;; Features that might be required by this library:
25 ;;; This file is NOT part of GNU Emacs
29 ;; This program is free software; you can redistribute it and/or modify
30 ;; it under the terms of the GNU General Public License as published by
31 ;; the Free Software Foundation; either version 3, or (at your option)
34 ;; This program is distributed in the hope that it will be useful,
35 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
36 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
37 ;; GNU General Public License for more details.
39 ;; You should have received a copy of the GNU General Public License
40 ;; along with this program; see the file COPYING. If not, write to
41 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth
42 ;; Floor, Boston, MA 02110-1301, USA.
46 ;; If this file does not work, upgrade anything.el!
47 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
51 ;; Predefined configurations for `anything.el'
53 ;; For quick start, try `anything-for-files' to open files.
55 ;; To configure anything you should setup `anything-sources'
56 ;; with specify source, like below:
58 ;; (setq anything-sources
59 ;; '(anything-c-source-buffers
60 ;; anything-c-source-buffer-not-found
61 ;; anything-c-source-file-name-history
62 ;; anything-c-source-info-pages
63 ;; anything-c-source-info-elisp
64 ;; anything-c-source-man-pages
65 ;; anything-c-source-locate
66 ;; anything-c-source-emacs-commands
69 ;; Below are complete source list you can setup in `anything-sources':
72 ;; `anything-c-source-buffers' (Buffers)
73 ;; `anything-c-source-buffer-not-found' (Create buffer)
74 ;; `anything-c-source-buffers+' (Buffers)
76 ;; `anything-c-source-file-name-history' (File Name History)
77 ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
78 ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
79 ;; `anything-c-source-file-cache' (File Cache)
80 ;; `anything-c-source-locate' (Locate)
81 ;; `anything-c-source-recentf' (Recentf)
82 ;; `anything-c-source-ffap-guesser' (File at point)
83 ;; `anything-c-source-ffap-line' (File/Lineno at point)
85 ;; `anything-c-source-man-pages' (Manual Pages)
86 ;; `anything-c-source-info-pages' (Info Pages)
87 ;; `anything-c-source-info-elisp' (Info Elisp)
88 ;; `anything-c-source-info-cl' (Info Common-Lisp)
90 ;; `anything-c-source-complex-command-history' (Complex Command History)
91 ;; `anything-c-source-extended-command-history' (Emacs Commands History)
92 ;; `anything-c-source-emacs-commands' (Emacs Commands)
93 ;; `anything-c-source-lacarte' (Lacarte)
95 ;; `anything-c-source-emacs-functions' (Emacs Functions)
96 ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
98 ;; `anything-c-source-emacs-variables' (Emacs Variables)
100 ;; `anything-c-source-bookmarks' (Bookmarks)
101 ;; `anything-c-source-bookmark-set' (Set Bookmark)
102 ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
103 ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
104 ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
105 ;; `anything-c-source-bookmark-regions' (Bookmark Regions)
106 ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
107 ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
108 ;; `anything-c-source-bookmark-info' (Bookmark Info)
109 ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
110 ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
111 ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
112 ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
114 ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
116 ;; `anything-c-source-imenu' (Imenu)
117 ;; `anything-c-source-ctags' (Exuberant ctags)
118 ;; `anything-c-source-semantic' (Semantic Tags)
119 ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
120 ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
121 ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
123 ;; `anything-c-source-customize-face' (Customize Face)
124 ;; `anything-c-source-colors' (Colors)
126 ;; `anything-c-source-tracker-search' (Tracker Search)
127 ;; `anything-c-source-mac-spotlight' (mdfind)
129 ;; `anything-c-source-icicle-region' (Icicle Regions)
131 ;; `anything-c-source-kill-ring' (Kill Ring)
133 ;; `anything-c-source-mark-ring' (mark-ring)
134 ;; `anything-c-source-global-mark-ring' (global-mark-ring)
136 ;; `anything-c-source-register' (Registers)
137 ;; Headline Extraction:
138 ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
139 ;; `anything-c-source-rd-headline' (RD HeadLine)
140 ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
141 ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
142 ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
143 ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
144 ;; `anything-c-source-org-headline' (Org HeadLine)
145 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
146 ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
147 ;; `anything-c-source-eev-anchor' (Anchors)
149 ;; `anything-c-source-picklist' (Picklist)
150 ;; `anything-c-source-bbdb' (BBDB)
151 ;; `anything-c-source-evaluation-result' (Evaluation Result)
152 ;; `anything-c-source-calculation-result' (Calculation Result)
153 ;; `anything-c-source-google-suggest' (Google Suggest)
154 ;; `anything-c-source-surfraw' (Surfraw)
155 ;; `anything-c-source-emms-streams' (Emms Streams)
156 ;; `anything-c-source-emms-dired' (Music Directory)
157 ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
158 ;; `anything-c-source-call-source' (Call anything source)
159 ;; `anything-c-source-occur' (Occur)
160 ;; `anything-c-source-create' (Create)
161 ;; `anything-c-source-minibuffer-history' (Minibuffer History)
162 ;; `anything-c-source-elscreen' (Elscreen)
164 ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
165 ;; `anything-c-source-xfonts' (X Fonts)
166 ;; `anything-c-source-gentoo' (Portage sources)
167 ;; `anything-c-source-use-flags' (Use Flags)
168 ;; `anything-c-source-emacs-process' (Emacs Process)
172 ;; Change log of this file is found at
173 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
178 ;; Tassilo Horn <tassilo@member.fsf.org>
179 ;; Vagn Johansen <gonz808@hotmail.com>
180 ;; Mathias Dahl <mathias.dahl@gmail.com>
181 ;; Bill Clementson <billclem@gmail.com>
182 ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
183 ;; Drew Adams <drew.adams@oracle.com>
184 ;; Jason McBrayer <jmcbray@carcosa.net>
185 ;; Andy Stewart <lazycat.manatee@gmail.com>
186 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
187 ;; rubikitch <rubikitch@ruby-lang.org>
188 ;; Scott Vokes <vokes.s@gmail.com>
193 ;; Evaluate (anything-c-insert-summary) before commit. This function
194 ;; generates anything-c-source-* list.
196 ;; Install also http://www.emacswiki.org/emacs/auto-document.el
197 ;; And eval it or run interactively.
199 ;; [EVAL IT] (anything-c-insert-summary)
200 ;; [EVAL IT] (auto-document)
202 ;; Please write details documentation about function, then others will
203 ;; read code more easier. -- Andy Stewart
209 ;; - anything-c-adaptive stores infos for sources/types that don't have
210 ;; set it as `filtered-candidate-transformer'.
212 ;; - Fix documentation, now many functions haven't documentations.
221 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Customize ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
222 (defgroup anything-config nil
223 "Predefined configurations for `anything.el'."
226 (defcustom anything-c-use-standard-keys nil
227 "Whether use standard keybindings. (no effect)
229 Key definitions in anything-config.el are removed because
230 anything.el uses Emacs-standard keys by default. e.g. M-p/M-n for
231 minibuffer history, C-s for isearch, etc.
233 If you use `iswitchb' with `anything',
234 evaluate (anything-iswitchb-setup) . Then some bindings that
235 conflict with `iswitchb', e.g. C-p/C-n for the minibuffer
236 history, are removed from `anything-map'. "
238 :group
'anything-config
)
240 (defcustom anything-c-adaptive-history-file
"~/.emacs.d/anything-c-adaptive-history"
241 "Path of file where history information is stored."
243 :group
'anything-config
)
245 (defcustom anything-c-adaptive-history-length
50
246 "Maximum number of candidates stored for a source."
248 :group
'anything-config
)
250 (defcustom anything-c-google-suggest-url
251 "http://www.google.com/complete/search?hl=en&js=true&qu="
252 "URL used for looking up suggestions."
254 :group
'anything-config
)
256 (defcustom anything-c-google-suggest-search-url
257 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
258 "URL used for searching."
260 :group
'anything-config
)
262 (defcustom anything-c-boring-buffer-regexp
268 " *Echo Area" " *Minibuf"))
269 "The regexp that match boring buffers.
270 Buffer candidates matching this regular expression will be
271 filtered from the list of candidates if the
272 `anything-c-skip-boring-buffers' candidate transformer is used, or
273 they will be displayed with face `file-name-shadow' if
274 `anything-c-shadow-boring-buffers' is used."
276 :group
'anything-config
)
277 ;; (string-match anything-c-boring-buffer-regexp "buf")
278 ;; (string-match anything-c-boring-buffer-regexp " hidden")
279 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
281 (defcustom anything-c-boring-file-regexp
283 ;; Boring directories
284 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol
))
286 (and line-start
".#")
287 (and (or ".class" ".la" ".o" "~") eol
)))
288 "The regexp that match boring files.
289 File candidates matching this regular expression will be
290 filtered from the list of candidates if the
291 `anything-c-skip-boring-files' candidate transformer is used, or
292 they will be displayed with face `file-name-shadow' if
293 `anything-c-shadow-boring-files' is used."
295 :group
'anything-config
)
297 (defcustom anything-kill-ring-threshold
10
298 "*Minimum length to be listed by `anything-c-source-kill-ring'."
300 :group
'anything-config
)
302 (defcustom anything-su-or-sudo
"su"
303 "What command to use for root access."
305 :group
'anything-config
)
307 (defcustom anything-for-files-prefered-list
'(anything-c-source-ffap-line
308 anything-c-source-ffap-guesser
309 anything-c-source-buffers
+
310 anything-c-source-recentf
311 anything-c-source-bookmarks
312 anything-c-source-file-cache
313 anything-c-source-files-in-current-dir
+
314 anything-c-source-locate
)
315 "Your prefered sources to find files."
317 :group
'anything-config
)
319 (defcustom anything-create--actions-private nil
320 "User defined actions for `anything-create' / `anything-c-source-create'.
321 It is a list of (DISPLAY . FUNCTION) pairs like `action'
322 attribute of `anything-sources'.
324 It is prepended to predefined pairs."
326 :group
'anything-config
)
328 (defcustom anything-allow-skipping-current-buffer t
329 "Show current buffer or not in anything buffer"
331 :group
'anything-config
)
333 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Preconfigured Anything ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
334 (defun anything-for-files ()
335 "Preconfigured `anything' for opening files.
336 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate"
338 (anything-other-buffer anything-for-files-prefered-list
"*anything for files*"))
340 (defun anything-info-at-point ()
341 "Preconfigured `anything' for searching info at point."
343 (anything '(anything-c-source-info-elisp
344 anything-c-source-info-cl
345 anything-c-source-info-pages
)
346 (thing-at-point 'symbol
) nil nil nil
"*anything info*"))
348 (defun anything-show-kill-ring ()
349 "Preconfigured `anything' for `kill-ring'. It is drop-in replacement of `yank-pop'.
350 You may bind this command to M-y."
352 (anything-other-buffer 'anything-c-source-kill-ring
"*anything kill-ring*"))
354 (defun anything-minibuffer-history ()
355 "Preconfigured `anything' for `minibuffer-history'."
357 (let ((enable-recursive-minibuffers t
))
358 (anything-other-buffer 'anything-c-source-minibuffer-history
359 "*anything minibuffer-history*")))
361 (dolist (map (list minibuffer-local-filename-completion-map
362 minibuffer-local-completion-map
363 minibuffer-local-must-match-filename-map
365 minibuffer-local-isearch-map
366 minibuffer-local-must-match-map
367 minibuffer-local-ns-map
))
368 (define-key map
"\C-r" 'anything-minibuffer-history
))
370 (defun anything-gentoo ()
371 "Preconfigured `anything' for gentoo linux."
373 (anything-other-buffer '(anything-c-source-gentoo
374 anything-c-source-use-flags
)
375 "*anything gentoo*"))
377 (defun anything-surfraw-only ()
378 "Preconfigured `anything' for surfraw.
379 If region is marked set anything-pattern to region.
380 With one prefix arg search symbol at point.
381 With two prefix args allow choosing in which symbol to search."
383 (let (search pattern
)
384 (cond ((region-active-p)
385 (setq pattern
(buffer-substring (region-beginning) (region-end))))
386 ((equal current-prefix-arg
'(4))
387 (setq pattern
(thing-at-point 'symbol
)))
388 ((equal current-prefix-arg
'(16))
391 (completing-read "Search in: "
392 (list "symbol" "sentence" "sexp" "line" "word"))))
393 (setq pattern
(thing-at-point search
))))
394 (anything 'anything-c-source-surfraw
395 (and pattern
(replace-regexp-in-string "\n" "" pattern
))
396 nil nil nil
"*anything surfraw*")))
398 (defun anything-imenu ()
399 "Preconfigured `anything' for `imenu'."
401 (anything 'anything-c-source-imenu nil nil nil nil
"*anything imenu*"))
403 (defun anything-google-suggest ()
404 "Preconfigured `anything' for google search with google suggest."
406 (anything-other-buffer 'anything-c-source-google-suggest
"*anything google*"))
408 ;;; Converted from anything-show-*-only
409 (defun anything-for-buffers ()
410 "Preconfigured `anything' for buffer."
412 (anything-other-buffer 'anything-c-source-buffers
"*anything for buffers*"))
414 (defun anything-bbdb ()
415 "Preconfigured `anything' for BBDB."
417 (anything-other-buffer 'anything-c-source-bbdb
"*anything bbdb*"))
419 (defun anything-locate ()
420 "Preconfigured `anything' for Locate."
422 (anything-other-buffer 'anything-c-source-locate
"*anything locate*"))
424 (defun anything-w3m-bookmarks ()
425 "Preconfigured `anything' for w3m bookmark."
427 (anything-other-buffer 'anything-c-source-w3m-bookmarks
"*anything w3m bookmarks*"))
429 (defun anything-colors ()
430 "Preconfigured `anything' for color."
432 (anything-other-buffer '(anything-c-source-colors anything-c-source-customize-face
)
433 "*anything colors*"))
437 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
439 (defun anything-kill-buffers ()
440 "You can continuously kill buffer you selected."
443 '(((name .
"Kill Buffers")
444 (candidates . anything-c-buffer-list
)
446 ("Kill Buffer" .
(lambda (candidate)
447 (kill-buffer candidate
)
448 (anything-kill-buffers)
453 (defun anything-query-replace-regexp (&rest args
)
454 "Drop-in replacement of `query-replace-regexp' with building regexp visually."
456 (or (anything-c-regexp-base "Query Replace Regexp: "
457 '((name .
"Lines matching Regexp")
458 (action . anything-c-query-replace-args
)))
460 (apply 'query-replace-regexp args
))
462 (defun anything-regexp ()
463 "It is like `re-builder'. It helps buliding regexp and replacement."
465 (anything-c-regexp-base
467 '((name .
"Regexp Builder")
469 ("Kill Regexp as sexp" .
470 (lambda (x) (anything-c-regexp-kill-new (prin1-to-string anything-input
))))
471 ("Query Replace Regexp" .
472 (lambda (x) (apply 'query-replace-regexp
(anything-c-query-replace-args (point)))))
474 (lambda (x) (anything-c-regexp-kill-new anything-input
)))))))
476 (defun anything-c-query-replace-args (start-point)
477 ;; create arguments of `query-replace-regexp'.
478 (let ((region-only (and transient-mark-mode mark-active
)))
481 (read-string (format "Query replace regexp %s%s%s with: "
482 (if region-only
"in region " "")
484 (if current-prefix-arg
"(word) " "")))
493 (defun anything-c-regexp-get-line (s e
)
497 (format "%5d: %s" (line-number-at-pos s
) (buffer-substring s e
))
499 (loop for i from
0 to
(1- (/ (length (match-data)) 2))
501 collect
(format "\n $%d = %s"
502 i
(match-string i
))))
504 'anything-realvalue s
))
506 (defun anything-c-regexp-persistent-action (txt)
507 (goto-line (anything-aif (string-match "^ *\\([0-9]+\\)" txt
)
508 (string-to-number (match-string 1 txt
)))))
510 (defun anything-c-regexp-base (prompt attributes
)
512 (let ((anything-compile-source-functions
513 ;; rule out anything-match-plugin because the input is one regexp.
514 (delq 'anything-compile-source--match-plugin
515 (copy-sequence anything-compile-source-functions
))))
516 (if (and transient-mark-mode mark-active
)
517 (narrow-to-region (region-beginning) (region-end)))
521 '((init .
(lambda () (anything-candidate-buffer anything-current-buffer
)))
522 (candidates-in-buffer)
523 (get-line . anything-c-regexp-get-line
)
524 (persistent-action . anything-c-regexp-persistent-action
)
528 nil prompt nil nil
"*anything regexp*"))))
530 (defun anything-c-regexp-kill-new (input)
532 (message "Killed: %s" input
))
534 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactive Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
536 (defun anything-insert-buffer-name ()
537 "Insert buffer name."
539 (anything-insert-string
540 (with-current-buffer anything-current-buffer
541 (if buffer-file-name
(file-name-nondirectory buffer-file-name
)
544 (defun anything-insert-symbol ()
545 "Insert current symbol."
547 (anything-insert-string
548 (with-current-buffer anything-current-buffer
550 (buffer-substring (beginning-of-thing 'symbol
)
551 (end-of-thing 'symbol
))))))
553 (defun anything-insert-selection ()
554 "Insert current selection."
556 (anything-insert-string
557 (with-current-buffer anything-current-buffer
558 (anything-get-selection))))
560 (defun anything-show-buffer-only ()
561 "[OBSOLETE] Only show sources about buffer.
562 Use `anything-for-buffers' instead."
564 (anything-set-source-filter '("Buffers")))
566 (defun anything-show-bbdb-only ()
567 "[OBSOLETE] Only show sources about BBDB.
568 Use `anything-bbdb' instead."
570 (anything-set-source-filter '("BBDB")))
572 (defun anything-show-locate-only ()
573 "[OBSOLETE] Only show sources about Locate.
574 Use `anything-locate' instead."
576 (anything-set-source-filter '("Locate")))
578 (defun anything-show-info-only ()
579 "[OBSOLETE] Only show sources about Info.
580 Use `anything-info-at-point' instead."
582 (anything-set-source-filter '("Info Pages"
584 "Info Common-Lisp")))
586 (defun anything-show-imenu-only ()
587 "[OBSOLETE] Only show sources about Imenu.
588 Use `anything-imenu' instead."
590 (anything-set-source-filter '("Imenu")))
592 (defun anything-show-files-only ()
593 "[OBSOLETE] Only show sources about File.
594 Use `anything-for-files' instead."
596 (anything-set-source-filter '("File Name History"
597 "Files from Current Directory"
600 (defun anything-show-w3m-bookmarks-only ()
601 "[OBSOLETE] Only show source about w3m bookmark.
602 Use `anything-w3m-bookmarks' instead."
604 (anything-set-source-filter '("W3m Bookmarks")))
606 (defun anything-show-colors-only ()
607 "[OBSOLETE] Only show source about color.
608 Use `anything-colors' instead."
610 (anything-set-source-filter '("Colors"
613 (defun anything-show-kill-ring-only ()
614 "[OBSOLETE] Only show source about kill ring.
615 Use `anything-show-kill-ring' instead."
617 (anything-set-source-filter '("Kill Ring")))
619 (defun anything-show-this-source-only ()
620 "Only show this source."
622 (setq anything-candidate-number-limit
9999)
623 (anything-set-source-filter
624 (list (assoc-default 'name
(anything-get-current-source)))))
626 (defun anything-test-sources ()
627 "List all anything sources for test.
628 The output is sexps which are evaluated by \\[eval-last-sexp]."
630 (with-output-to-temp-buffer "*Anything Test Sources*"
631 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s
)))
632 (apropos-internal "^anything-c-source" #'boundp
))
633 (pop-to-buffer standard-output
)))
635 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Utilities Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
636 ;;; For compatibility
637 (unless (fboundp 'region-active-p
)
638 (defun region-active-p ()
639 "Return t if Transient Mark mode is enabled and the mark is active.
641 Most commands that act on the region if it is active and
642 Transient Mark mode is enabled, and on the text near point
643 otherwise, should use `use-region-p' instead. That function
644 checks the value of `use-empty-active-region' as well."
645 (and transient-mark-mode mark-active
)))
647 (defun anything-nest (&rest same-as-anything
)
648 "Nested `anything'. If you use `anything' within `anything', use it."
649 (with-selected-window (anything-window)
650 (let (anything-current-position
651 anything-current-buffer
652 (orig-anything-buffer anything-buffer
)
656 anything-compiled-sources
657 anything-buffer-chars-modified-tick
658 (anything-samewindow t
)
659 (enable-recursive-minibuffers t
))
661 (apply #'anything same-as-anything
)
662 (anything-initialize-overlays orig-anything-buffer
)
663 (add-hook 'post-command-hook
'anything-check-minibuffer-input
)))))
665 (defun anything-displaying-source-names ()
666 "Display sources name."
667 (with-current-buffer anything-buffer
668 (goto-char (point-min))
670 while
(setq pos
(next-single-property-change (point) 'anything-header
))
672 collect
(buffer-substring-no-properties (point-at-bol)(point-at-eol))
673 do
(forward-line 1))))
675 (defun anything-select-source ()
678 (let ((default (assoc-default 'name
(anything-get-current-source)))
679 (source-names (anything-displaying-source-names))
680 (all-source-names (mapcar (lambda (s) (assoc-default 'name s
))
681 (anything-get-sources))))
682 (setq anything-candidate-number-limit
9999)
684 (let (anything-source-filter)
685 (anything-nest '(((name .
"Anything Source")
686 (candidates . source-names
)
688 ((name .
"Anything Source (ALL)")
689 (candidates . all-source-names
)
690 (action . identity
)))
692 default
"*anything select source*"))
693 (anything-set-source-filter (list it
))
694 (anything-set-source-filter nil
))))
696 (defun anything-insert-string (str)
698 (delete-minibuffer-contents)
701 (defun anything-c-match-on-file-name (candidate)
702 "Return non-nil if `anything-pattern' match the filename (without directory part) of CANDIDATE."
703 (string-match anything-pattern
(file-name-nondirectory candidate
)))
705 (defun anything-c-match-on-directory-name (candidate)
706 "Return non-nil if `anything-pattern' match the directory part of CANDIDATE (a file)."
707 (anything-aif (file-name-directory candidate
)
708 (string-match anything-pattern it
)))
710 (defun anything-c-string-match (candidate)
711 "Return non-nil if `anything-pattern' match CANDIDATE.
712 The match is done with `string-match'."
713 (string-match anything-pattern candidate
))
715 ;; `anything-c-compose' is no more needed, it is for compatibility.
716 (defalias 'anything-c-compose
'anything-compose
)
718 (defun anything-c-skip-entries (list regexp
)
719 "Remove entries which matches REGEXP from LIST."
720 (remove-if (lambda (x) (and (stringp x
) (string-match regexp x
)))
723 (defun anything-c-shadow-entries (list regexp
)
724 "Elements of LIST matching REGEXP will be displayed with the `file-name-shadow' face if available."
725 (mapcar (lambda (file)
726 ;; Add shadow face property to boring files.
727 (let ((face (if (facep 'file-name-shadow
)
729 ;; fall back to default on XEmacs
731 (if (string-match regexp file
)
732 (setq file
(propertize file
'face face
))))
736 (defsubst anything-c-stringify
(str-or-sym)
737 "Get string of STR-OR-SYM."
738 (if (stringp str-or-sym
)
740 (symbol-name str-or-sym
)))
742 (defsubst anything-c-symbolify
(str-or-sym)
743 "Get symbol of STR-OR-SYM."
744 (if (symbolp str-or-sym
)
746 (intern str-or-sym
)))
748 (defun anything-c-describe-function (func)
749 "FUNC is symbol or string."
750 (describe-function (anything-c-symbolify func
)))
752 (defun anything-c-describe-variable (var)
753 "VAR is symbol or string."
754 (describe-variable (anything-c-symbolify var
)))
756 (defun anything-c-find-function (func)
757 "FUNC is symbol or string."
758 (find-function (anything-c-symbolify func
)))
760 (defun anything-c-find-variable (var)
761 "VAR is symbol or string."
762 (find-variable (anything-c-symbolify var
)))
764 (defun anything-c-kill-new (string &optional replace yank-handler
)
765 "STRING is symbol or string."
766 (kill-new (anything-c-stringify string
) replace yank-handler
))
768 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Prefix argument in action ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
770 (defvar anything-current-prefix-arg nil
771 "`current-prefix-arg' when selecting action.
772 It is cleared after executing action.")
774 (defadvice anything-exit-minibuffer
(before anything-current-prefix-arg activate
)
775 (unless anything-current-prefix-arg
776 (setq anything-current-prefix-arg current-prefix-arg
)))
778 (add-hook 'anything-after-action-hook
779 (lambda () (setq anything-current-prefix-arg nil
)))
782 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Document Generator ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
783 (defun anything-c-create-summary ()
784 "Create `anything' summary."
786 (goto-char (point-min))
787 (loop while
(re-search-forward "^;;;; <\\(.+?\\)>$\\|^;; (anything '\\(.+?\\))$\\|^ *;; (anything '\\(.+?\\))$" nil t
)
788 collect
(cond ((match-beginning 1)
789 (cons 'section
(match-string-no-properties 1)))
792 (cons (match-string-no-properties 2)
793 (assoc-default 'name
(symbol-value (intern (match-string-no-properties 2)))))))
796 (cons (match-string-no-properties 3)
797 (assoc-default 'name
(symbol-value (intern (match-string-no-properties 3)))))))))))
799 ;; (find-epp (anything-c-create-summary))
801 (defun anything-c-insert-summary ()
802 "Insert `anything' summary."
804 (goto-char (point-min))
805 (search-forward ";; Below are complete source list you can setup in")
807 (delete-region (point)
808 (progn (search-forward ";;; Change log:" nil t
)
809 (forward-line -
1) (point)))
812 for
(kind . value
) in
(anything-c-create-summary)
814 do
(cond ((eq kind
'section
)
816 (align-regexp beg
(point) "\\(\\s-*\\)(" 1 1 nil
))
817 (insert ";; " value
":\n")
820 (insert ";; `" (car value
) "' (" (cdr value
) ")\n")))
821 finally
(align-regexp beg
(point) "\\(\\s-*\\)(" 1 1 nil
))))
822 ;; (anything-c-insert-summary)
824 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Sources ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
826 (defun anything-c-buffer-list ()
827 "Return the list of names of buffers with boring buffers filtered out.
828 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
829 The first buffer in the list will be the last recently used
830 buffer that is not the current buffer."
831 (let ((buffers (mapcar 'buffer-name
(buffer-list))))
832 (append (cdr buffers
) (list (car buffers
)))))
834 (defvar anything-c-source-buffers
836 (candidates . anything-c-buffer-list
)
839 ;; (anything 'anything-c-source-buffers)
841 (defvar anything-c-source-buffer-not-found
842 '((name .
"Create buffer")
845 ;; (anything 'anything-c-source-buffer-not-found)
848 (defface anything-dir-heading
'((t (:foreground
"Blue" :background
"Pink")))
849 "*Face used for directory headings in dired buffers."
852 (defface anything-file-name
853 '((t (:foreground
"Blue")))
854 "*Face used for file names (without suffixes) in dired buffers."
857 (defface anything-dir-priv
858 '((t (:foreground
"DarkRed" :background
"LightGray")))
859 "*Face used for directory privilege indicator (d) in dired buffers."
862 (defvar anything-c-buffers-face1
'anything-dir-priv
)
863 (defvar anything-c-buffers-face2
'font-lock-type-face
)
864 (defvar anything-c-buffers-face3
'italic
)
865 (eval-when-compile (require 'dired
))
866 (defun anything-c-highlight-buffers (buffers)
868 (loop for i in buffers
869 if
(rassoc (get-buffer i
) dired-buffers
)
870 collect
(propertize i
871 'face anything-c-buffers-face1
872 'help-echo
(car (rassoc (get-buffer i
) dired-buffers
)))
873 if
(buffer-file-name (get-buffer i
))
874 collect
(propertize i
875 'face anything-c-buffers-face2
876 'help-echo
(buffer-file-name (get-buffer i
)))
877 if
(and (not (rassoc (get-buffer i
) dired-buffers
))
878 (not (buffer-file-name (get-buffer i
))))
879 collect
(propertize i
880 'face anything-c-buffers-face3
)))
882 (defvar anything-c-source-buffers
+
884 (candidates . anything-c-buffer-list
)
887 (candidate-transformer anything-c-skip-current-buffer
888 anything-c-highlight-buffers
889 anything-c-skip-boring-buffers
)
890 (persistent-action . anything-c-buffers
+-persistent-action
)))
892 (defun anything-c-buffers+-persistent-action
(name)
894 (with-current-buffer item
895 (if (and (buffer-modified-p)
896 (buffer-file-name (current-buffer)))
900 (kill-buffer item
))))
902 (switch-to-buffer item
)))
903 (if current-prefix-arg
906 (anything-delete-current-selection))
909 ;; (anything 'anything-c-source-buffers+)
913 ;;; File name history
914 (defvar anything-c-source-file-name-history
915 '((name .
"File Name History")
916 (candidates . file-name-history
)
917 (match anything-c-match-on-file-name
918 anything-c-match-on-directory-name
)
920 ;; (anything 'anything-c-source-file-name-history)
922 ;;; Files in current dir
923 (defvar anything-c-source-files-in-current-dir
924 '((name .
"Files from Current Directory")
925 (init .
(lambda () (setq anything-c-default-directory default-directory
)))
926 (candidates .
(lambda () (directory-files anything-c-default-directory
)))
929 ;; (anything 'anything-c-source-files-in-current-dir)
931 (defvar anything-c-files-face1
'anything-dir-priv
)
932 (defvar anything-c-files-face2
'anything-file-name
)
933 (defun anything-c-highlight-files (files)
935 if
(file-directory-p i
)
936 collect
(propertize (file-name-nondirectory i
)
937 'face anything-c-files-face1
938 'help-echo
(expand-file-name i
))
940 collect
(propertize (file-name-nondirectory i
)
941 'face anything-c-files-face2
942 'help-echo
(expand-file-name i
))))
945 (defvar anything-c-source-files-in-current-dir
+
946 '((name .
"Files from Current Directory")
948 (setq anything-c-default-directory
949 (expand-file-name default-directory
))))
950 (candidates .
(lambda ()
952 anything-c-default-directory t
)))
953 (candidate-transformer anything-c-highlight-files
)
957 ;; (anything 'anything-c-source-files-in-current-dir+)
960 (defvar anything-c-source-file-cache-initialized nil
)
962 (defvar anything-c-file-cache-files nil
)
964 (defvar anything-c-source-file-cache
965 '((name .
"File Cache")
967 (require 'filecache nil t
)
968 (unless anything-c-source-file-cache-initialized
969 (setq anything-c-file-cache-files
970 (loop for item in file-cache-alist append
971 (destructuring-bind (base &rest dirs
) item
972 (loop for dir in dirs collect
973 (concat dir base
)))))
974 (defadvice file-cache-add-file
(after file-cache-list activate
)
975 (add-to-list 'anything-c-file-cache-files
(expand-file-name file
)))
976 (setq anything-c-source-file-cache-initialized t
))))
977 (candidates . anything-c-file-cache-files
)
978 (match anything-c-match-on-file-name
979 anything-c-match-on-directory-name
)
981 ;; (anything 'anything-c-source-file-cache)
984 (defvar anything-c-locate-options
986 ((eq system-type
'darwin
) '("locate"))
987 ((eq system-type
'berkeley-unix
) '("locate" "-i"))
988 (t '("locate" "-i" "-r")))
989 "A list where the `car' is the name of the locat program followed by options.
990 The search pattern will be appended, so the
991 \"-r\" option should be the last option.")
993 (defvar anything-c-source-locate
995 (candidates .
(lambda ()
996 (apply 'start-process
"locate-process" nil
997 (append anything-c-locate-options
998 (list anything-pattern
)))))
1000 (requires-pattern .
3)
1002 "Source for retrieving files matching the current input pattern with locate.")
1003 ;; (anything 'anything-c-source-locate)
1006 (defvar anything-c-source-recentf
1007 '((name .
"Recentf")
1010 (or recentf-mode
(recentf-mode 1))
1011 ;; Big value empowers anything/recentf
1012 (when (and (numberp recentf-max-saved-items
)
1013 (<= recentf-max-saved-items
20))
1014 (setq recentf-max-saved-items
500))))
1015 (candidates . recentf-list
)
1016 (match anything-c-match-on-file-name
1017 anything-c-match-on-directory-name
)
1019 "See (info \"(emacs)File Conveniences\").
1020 if `recentf-max-saved-items' is too small, set it to 500.")
1021 ;; (anything 'anything-c-source-recentf)
1024 (eval-when-compile (require 'ffap
))
1025 (defvar anything-c-source-ffap-guesser
1026 '((name .
"File at point")
1027 (init .
(lambda () (require 'ffap
)))
1028 (candidates .
(lambda ()
1030 (with-current-buffer anything-current-buffer
1034 ;; (anything 'anything-c-source-ffap-guesser)
1036 ;;; ffap with line number
1037 (defun anything-c-ffap-file-line-at-point ()
1038 "Get (FILENAME . LINENO) at point."
1039 (anything-aif (let (ffap-alist) (ffap-file-at-point))
1042 (when (and (search-forward it nil t
)
1043 (looking-at ":\\([0-9]+\\)"))
1044 (cons it
(string-to-number (match-string 1)))))))
1046 (defvar anything-c-ffap-line-location nil
1047 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
1048 It is cleared after jumping line.")
1050 (defun anything-c-ffap-line-candidates ()
1051 (with-current-buffer anything-current-buffer
1052 (setq anything-c-ffap-line-location
(anything-c-ffap-file-line-at-point)))
1053 (when anything-c-ffap-line-location
1054 (destructuring-bind (file . line
) anything-c-ffap-line-location
1055 (list (cons (format "%s (line %d)" file line
) file
)))))
1057 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
1058 (defun anything-c-ffap-line-goto-line ()
1059 (when (car anything-c-ffap-line-location
)
1062 (with-selected-window (get-buffer-window
1063 (get-file-buffer (car anything-c-ffap-line-location
)))
1064 (goto-line (cdr anything-c-ffap-line-location
))))
1065 (setq anything-c-ffap-line-location nil
))))
1066 (add-hook 'anything-after-action-hook
'anything-c-ffap-line-goto-line
)
1068 (defvar anything-c-source-ffap-line
1069 '((name .
"File/Lineno at point")
1070 (init .
(lambda () (require 'ffap
)))
1071 (candidates . anything-c-ffap-line-candidates
)
1073 ;; (anything 'anything-c-source-ffap-line)
1078 (defvar anything-c-man-pages nil
1079 "All man pages on system.
1080 Will be calculated the first time you invoke anything with this
1083 (defvar anything-c-source-man-pages
1084 `((name .
"Manual Pages")
1085 (candidates .
(lambda ()
1086 (if anything-c-man-pages
1087 anything-c-man-pages
1088 ;; XEmacs doesn't have a woman :)
1089 (setq anything-c-man-pages
1092 (woman-file-name "")
1093 (sort (mapcar 'car woman-topic-all-completions
)
1095 (action ("Show with Woman" . woman
))
1096 (requires-pattern .
2)))
1097 ;; (anything 'anything-c-source-man-pages)
1100 (defvar anything-c-info-pages nil
1101 "All info pages on system.
1102 Will be calculated the first time you invoke anything with this
1105 (defvar anything-c-source-info-pages
1106 `((name .
"Info Pages")
1107 (candidates .
(lambda ()
1108 (if anything-c-info-pages
1109 anything-c-info-pages
1110 (setq anything-c-info-pages
1111 (save-window-excursion
1114 (Info-find-node "dir" "top")
1115 (goto-char (point-min))
1116 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
1118 (while (re-search-forward info-topic-regexp nil t
)
1119 (add-to-list 'topics
(match-string-no-properties 1)))
1120 (goto-char (point-min))
1123 (action .
(("Show with Info" .
(lambda (node-str)
1124 (info (replace-regexp-in-string "^[^:]+: "
1127 (requires-pattern .
2)))
1128 ;; (anything 'anything-c-source-info-pages)
1131 (defvar anything-c-info-elisp nil
)
1132 (defvar anything-c-source-info-elisp
1133 `((name .
"Info Elisp")
1135 (save-window-excursion
1136 (unless anything-c-info-elisp
1138 (Info-find-node "elisp" "Index")
1139 (setq anything-c-info-elisp
(split-string (buffer-string) "\n"))
1141 (candidates .
(lambda ()
1142 (loop for i in anything-c-info-elisp
1143 if
(string-match "^* [^ \n]+[^: ]" i
)
1144 collect
(match-string 0 i
))))
1145 (action .
(lambda (candidate)
1146 (Info-find-node "elisp" "Index")
1147 (Info-index (replace-regexp-in-string "* " "" candidate
))))
1149 (requires-pattern .
2)))
1150 ;; (anything 'anything-c-source-info-elisp)
1153 (defvar anything-c-info-cl-fn nil
)
1154 (defvar anything-c-source-info-cl
1155 `((name .
"Info Common-Lisp")
1157 (save-window-excursion
1158 (unless anything-c-info-cl-fn
1160 (Info-find-node "cl" "Function Index")
1161 (setq anything-c-info-cl-fn
(split-string (buffer-string) "\n"))
1163 (candidates .
(lambda ()
1164 (loop for i in anything-c-info-cl-fn
1165 if
(string-match "^* [^ \n]+[^: ]" i
)
1166 collect
(match-string 0 i
))))
1167 (action .
(lambda (candidate)
1168 (Info-find-node "cl" "Function Index")
1169 (Info-index (replace-regexp-in-string "* " "" candidate
))))
1171 (requires-pattern .
2)))
1172 ;; (anything 'anything-c-source-info-cl)
1175 ;;; Complex command history
1176 (defvar anything-c-source-complex-command-history
1177 '((name .
"Complex Command History")
1178 (candidates .
(lambda () (mapcar 'prin1-to-string command-history
)))
1180 ;; (anything 'anything-c-source-complex-command-history)
1183 (defvar anything-c-source-extended-command-history
1184 '((name .
"Emacs Commands History")
1185 (candidates . extended-command-history
)
1187 ;; (anything 'anything-c-source-extended-command-history)
1190 (defvar anything-c-source-emacs-commands
1191 '((name .
"Emacs Commands")
1192 (candidates .
(lambda ()
1194 (mapatoms (lambda (a)
1196 (push (symbol-name a
)
1198 (sort commands
'string-lessp
))))
1201 (requires-pattern .
2))
1202 "Source for completing and invoking Emacs commands.
1203 A command is a function with interactive spec that can
1204 be invoked with `M-x'.
1206 To get non-interactive functions listed, use
1207 `anything-c-source-emacs-functions'.")
1208 ;; (anything 'anything-c-source-emacs-commands)
1211 (defvar anything-c-source-lacarte
1212 '((name .
"Lacarte")
1213 (init .
(lambda () (require 'lacarte
)))
1214 (candidates .
(lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
1215 (candidate-number-limit .
9999)
1216 (action . anything-c-call-interactively
))
1219 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
1220 ;; (anything 'anything-c-source-lacarte)
1224 (defvar anything-c-source-emacs-functions
1225 '((name .
"Emacs Functions")
1226 (candidates .
(lambda ()
1228 (mapatoms (lambda (a) (if (functionp a
)
1229 (push (symbol-name a
) commands
))))
1230 (sort commands
'string-lessp
))))
1233 (requires-pattern .
2))
1234 "Source for completing Emacs functions.")
1235 ;; (anything 'anything-c-source-emacs-functions)
1237 ;;; With abbrev expansion
1238 ;;; Similar to my exec-abbrev-cmd.el
1239 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
1240 (defvar anything-c-function-abbrev-regexp nil
1241 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
1242 Regexp built from the current `anything-pattern' interpreting it
1244 Only for internal use.")
1246 (defun anything-c-match-function-by-abbrev (candidate)
1247 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
1249 Abbreviations are made by taking the first character from each
1250 word in the function's name, e.g. \"bb\" is an abbrev for
1251 `bury-buffer', \"stb\" is an abbrev for `switch-to-buffer'."
1252 (string-match anything-c-function-abbrev-regexp candidate
))
1254 (defvar anything-c-source-emacs-functions-with-abbrevs
1255 (append anything-c-source-emacs-functions
1256 '((match anything-c-match-function-by-abbrev
1257 anything-c-string-match
))
1258 '((init .
(lambda ()
1259 (defadvice anything-update
1260 (before anything-c-update-function-abbrev-regexp activate
)
1261 (let ((char-list (append anything-pattern nil
))
1263 (dolist (c char-list
)
1264 (setq str
(concat str
(list c
) "[^-]*-")))
1265 (setq str
(concat (substring str
0 (1- (length str
))) "$"))
1266 (setq anything-c-function-abbrev-regexp str
))))))))
1267 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
1271 (defvar anything-c-source-emacs-variables
1272 '((name .
"Emacs Variables")
1273 (candidates .
(lambda ()
1274 (sort (all-completions "" obarray
'boundp
) 'string-lessp
)))
1276 (requires-pattern .
2))
1277 "Source for completing Emacs variables.")
1278 ;; (anything 'anything-c-source-emacs-variables)
1282 (eval-when-compile (require 'bookmark
))
1283 (defvar anything-c-source-bookmarks
1284 '((name .
"Bookmarks")
1286 (require 'bookmark
)))
1287 (candidates . bookmark-all-names
)
1289 "See (info \"(emacs)Bookmarks\").")
1290 ;; (anything 'anything-c-source-bookmarks)
1293 (defvar anything-c-source-bookmark-set
1294 '((name .
"Set Bookmark")
1296 (action . bookmark-set
))
1297 "See (info \"(emacs)Bookmarks\").")
1298 ;; (anything 'anything-c-source-bookmark-set)
1300 ;;; Visible Bookmarks
1301 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
1304 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
1305 (defvar anything-c-source-bm
1306 '((name .
"Visible Bookmarks")
1307 (init . anything-c-bm-init
)
1308 (candidates-in-buffer)
1312 http://www.nongnu.org/bm/")
1314 (defun anything-c-bm-init ()
1315 "Init function for `anything-c-source-bm'."
1316 (when (require 'bm nil t
)
1318 (let ((bookmarks (bm-lists))
1319 (buf (anything-candidate-buffer 'global
)))
1320 (dolist (bm (sort* (append (car bookmarks
) (cdr bookmarks
))
1321 '< :key
'overlay-start
))
1322 (let ((start (overlay-start bm
))
1323 (end (overlay-end bm
))
1324 (annotation (or (overlay-get bm
'annotation
) "")))
1325 (unless (< (- end start
) 1) ; org => (if (< (- end start) 2)
1326 (let ((str (format "%7d: [%s]: %s\n"
1327 (line-number-at-pos start
)
1329 (buffer-substring start
(1- end
)))))
1330 (with-current-buffer buf
(insert str
))))))))))
1332 ;;; Special bookmarks
1333 (defvar anything-c-source-bookmarks-ssh
1334 '((name .
"Bookmarks-ssh")
1336 (require 'bookmark
)))
1338 (candidates .
(lambda ()
1339 (let (lis-all lis-ssh
)
1340 (setq lis-all
(bookmark-all-names))
1341 (setq lis-ssh
(loop for i in lis-all
1342 if
(string-match "^(ssh)" i
)
1344 (sort lis-ssh
'string-lessp
))))
1346 "See (info \"(emacs)Bookmarks\").")
1347 ;; (anything 'anything-c-source-bookmarks-ssh)
1349 (defvar anything-c-source-bookmarks-su
1350 '((name .
"Bookmarks-root")
1352 (require 'bookmark
)))
1354 (candidates .
(lambda ()
1355 (let (lis-all lis-su
)
1356 (setq lis-all
(bookmark-all-names))
1357 (setq lis-su
(loop for i in lis-all
1358 if
(string-match (format "^(%s)" anything-su-or-sudo
) i
)
1360 (sort lis-su
'string-lessp
))))
1361 (candidate-transformer anything-c-highlight-bookmark-su
)
1364 "See (info \"(emacs)Bookmarks\").")
1365 ;; (anything 'anything-c-source-bookmarks-su)
1367 (defface anything-bookmarks-su-face
'((t (:foreground
"red")))
1369 :group
'traverse-faces
)
1371 (defvar anything-c-bookmarks-face1
'anything-dir-heading
)
1372 (defvar anything-c-bookmarks-face2
'anything-file-name
)
1373 (defvar anything-c-bookmarks-face3
'anything-bookmarks-su-face
)
1375 (defun tv-root-logged-p ()
1377 (dolist (i (mapcar #'buffer-name
(buffer-list)))
1378 (when (string-match (format "*tramp/%s ." anything-su-or-sudo
) i
)
1379 (throw 'break t
)))))
1382 (defun anything-c-highlight-bookmark-su (files)
1383 (if (tv-root-logged-p)
1384 (anything-c-highlight-bookmark files
)
1385 (anything-c-highlight-not-logged files
)))
1387 (defun anything-c-highlight-not-logged (files)
1388 (loop for i in files
1389 collect
(propertize i
'face anything-c-bookmarks-face3
)))
1391 (defun anything-c-highlight-bookmark (bookmarks)
1393 Grey ==> non--buffer-filename with saved region or not.
1394 Yellow ==> w3m url with saved region.
1395 Magenta ==> Gnus buffer.
1396 Green ==> info buffer with saved region.
1397 Blue ==> regular file with maybe a region saved.
1398 RedOnWhite ==> Directory."
1399 (loop for i in bookmarks
1400 for pred
= (bookmark-get-filename i
)
1401 for bufp
= (and (fboundp 'bookmarkp-get-buffer-name
)
1402 (bookmarkp-get-buffer-name i
))
1403 for regp
= (and (fboundp 'bookmarkp-get-end-position
)
1404 (bookmarkp-get-end-position i
)
1405 (/= (bookmark-get-position i
)
1406 (bookmarkp-get-end-position i
)))
1407 for handlerp
= (and (fboundp 'bookmark-get-handler
)
1408 (bookmark-get-handler i
))
1409 for isannotation
= (bookmark-get-annotation i
)
1410 if
(and isannotation
(not (string-equal isannotation
"")))
1411 do
(setq i
(concat "*" i
))
1413 if
(and (fboundp 'bookmarkp-get-buffer-name
)
1414 (eq handlerp
'Info-bookmark-jump
)
1415 (string= bufp
"*info*"))
1416 collect
(propertize i
'face
'((:foreground
"green")) 'help-echo pred
)
1418 if
(and (fboundp 'bookmarkp-get-buffer-name
)
1419 (string= bufp
"*w3m*"))
1420 collect
(propertize i
'face
'((:foreground
"yellow")) 'help-echo pred
)
1422 if
(eq handlerp
'bookmarkp-jump-gnus
)
1423 collect
(propertize i
'face
'((:foreground
"magenta")) 'help-echo pred
)
1426 (file-directory-p pred
))
1427 collect
(propertize i
'face anything-c-bookmarks-face1
'help-echo pred
)
1428 ;; regular files with regions saved
1430 (not (file-directory-p pred
))
1431 (file-exists-p pred
)
1433 collect
(propertize i
'face
'((:foreground
"Indianred2")) 'help-echo pred
)
1436 (not (file-directory-p pred
))
1437 (file-exists-p pred
)
1439 collect
(propertize i
'face anything-c-bookmarks-face2
'help-echo pred
)
1440 ;; buffer non--filename
1441 if
(and (fboundp 'bookmarkp-get-buffer-name
)
1443 (not (bookmark-get-handler i
))
1444 (if pred
(not (file-exists-p pred
)) (not pred
)))
1445 collect
(propertize i
'face
'((:foreground
"grey")))))
1448 (defvar anything-c-source-bookmarks-local
1449 '((name .
"Bookmarks-Local")
1451 (require 'bookmark
)))
1453 (candidates .
(lambda ()
1454 (let (lis-all lis-loc
)
1455 (setq lis-all
(bookmark-all-names))
1456 (setq lis-loc
(loop for i in lis-all
1457 if
(and (not (string-match "^(ssh)" i
))
1458 (not (string-match "^(su)" i
)))
1460 (sort lis-loc
'string-lessp
))))
1461 (candidate-transformer anything-c-highlight-bookmark
)
1463 "See (info \"(emacs)Bookmarks\").")
1464 ;; (anything 'anything-c-source-bookmarks-local)
1466 ;;; Sources to filter bookmark+ bookmarks.
1467 ;; Dependency: http://www.emacswiki.org/cgi-bin/emacs/bookmark+.el
1469 (when (require 'bookmark
+ nil t
)
1470 (bookmark-maybe-load-default-file)
1472 (defun anything-c-bookmark+-filter-setup-alist
(fn &rest args
)
1473 "Return a filtered `bookmark-alist' using one of the bookmark+ filters functions."
1475 with alist
= (if args
1476 (apply #'(lambda (x) (funcall fn x
)) args
)
1481 finally return
(sort sa
'string-lessp
)))
1484 (defvar anything-c-source-bookmark-regions
1485 '((name .
"Bookmark Regions")
1486 (candidates . anything-c-bookmark-region-setup-alist
)
1487 (candidate-transformer anything-c-highlight-bookmark
)
1490 ;; (anything 'anything-c-source-bookmark-regions)
1492 (defun anything-c-bookmark-region-setup-alist ()
1493 "Specialized filter function for bookmark+ regions."
1494 (anything-c-bookmark+-filter-setup-alist
'bookmarkp-region-alist-only
))
1497 (defvar anything-c-source-bookmark-w3m
1498 '((name .
"Bookmark W3m")
1499 (candidates . anything-c-bookmark-w3m-setup-alist
)
1500 (candidate-transformer anything-c-highlight-bookmark
)
1503 ;; (anything 'anything-c-source-bookmark-w3m)
1505 (defun anything-c-bookmark-w3m-setup-alist ()
1506 "Specialized filter function for bookmark+ w3m."
1507 (anything-c-bookmark+-filter-setup-alist
'bookmarkp-w3m-alist-only
))
1510 (defvar anything-c-source-bookmark-gnus
1511 '((name .
"Bookmark Gnus")
1512 (candidates . anything-c-bookmark-gnus-setup-alist
)
1513 (candidate-transformer anything-c-highlight-bookmark
)
1515 ;; (anything 'anything-c-source-bookmark-gnus)
1517 (defun anything-c-bookmark-gnus-setup-alist ()
1518 "Specialized filter function for bookmark+ gnus."
1519 (anything-c-bookmark+-filter-setup-alist
'bookmarkp-gnus-alist-only
))
1522 (defvar anything-c-source-bookmark-info
1523 '((name .
"Bookmark Info")
1524 (candidates . anything-c-bookmark-info-setup-alist
)
1525 (candidate-transformer anything-c-highlight-bookmark
)
1527 ;; (anything 'anything-c-source-bookmark-info)
1529 (defun anything-c-bookmark-info-setup-alist ()
1530 "Specialized filter function for bookmark+ info."
1531 (anything-c-bookmark+-filter-setup-alist
'bookmarkp-info-alist-only
))
1533 ;; Local Files&directories
1534 (defvar anything-c-source-bookmark-files
&dirs
1535 '((name .
"Bookmark Files&Directories")
1536 (candidates . anything-c-bookmark-local-files-setup-alist
)
1537 (candidate-transformer anything-c-highlight-bookmark
)
1539 ;; (anything 'anything-c-source-bookmark-files&dirs)
1541 (defun anything-c-bookmark-local-files-setup-alist ()
1542 "Specialized filter function for bookmark+ locals files."
1543 (anything-c-bookmark+-filter-setup-alist
'bookmarkp-local-file-alist-only
))
1545 ;; Su Files&directories
1547 (defun anything-c-highlight-bookmark+-su
(bmk)
1548 (if (bookmarkp-root-or-sudo-logged-p)
1549 (anything-c-highlight-bookmark bmk
)
1550 (anything-c-highlight-not-logged bmk
)))
1552 (defvar anything-c-source-bookmark-su-files
&dirs
1553 '((name .
"Bookmark Root-Files&Directories")
1554 (candidates . anything-c-bookmark-su-files-setup-alist
)
1555 (candidate-transformer anything-c-highlight-bookmark
+-su
)
1557 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
1559 (defun anything-c-bookmark-su-files-setup-alist ()
1560 "Specialized filter function for bookmark+ su/sudo files."
1562 with l
= (anything-c-bookmark+-filter-setup-alist
'bookmarkp-remote-file-alist-only
)
1564 for isfile
= (bookmark-get-filename i
)
1565 for istramp
= (and isfile
(boundp 'tramp-file-name-regexp
)
1567 (string-match tramp-file-name-regexp isfile
)))
1568 for issu
= (and istramp
1569 (string-match bookmarkp-su-or-sudo-regexp isfile
))
1573 ;; Ssh Files&directories
1574 (defvar anything-c-source-bookmark-ssh-files
&dirs
1575 '((name .
"Bookmark Ssh-Files&Directories")
1576 (candidates . anything-c-bookmark-ssh-files-setup-alist
)
1578 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
1580 (defun anything-c-bookmark-ssh-files-setup-alist ()
1581 "Specialized filter function for bookmark+ ssh files."
1583 with l
= (anything-c-bookmark+-filter-setup-alist
'bookmarkp-remote-file-alist-only
)
1585 for isfile
= (bookmark-get-filename i
)
1586 for istramp
= (and isfile
(boundp 'tramp-file-name-regexp
)
1588 (string-match tramp-file-name-regexp isfile
)))
1589 for isssh
= (and istramp
1590 (string-match "/ssh:" isfile
))
1594 ;; All bookmark+ sources.
1595 (defun anything-bookmark+ ()
1596 "Preconfigured anything for bookmark+ sources."
1598 (anything '(anything-c-source-bookmark-files&dirs
1599 anything-c-source-bookmark-w3m
1600 anything-c-source-bookmark-gnus
1601 anything-c-source-bookmark-regions
1602 anything-c-source-bookmark-su-files
&dirs
1603 anything-c-source-bookmark-ssh-files
&dirs
))))
1607 (eval-when-compile (require 'w3m-bookmark nil t
))
1608 (unless (and (require 'w3m nil t
)
1609 (require 'w3m-bookmark nil t
))
1610 (defvar w3m-bookmark-file
"~/.w3m/bookmark.html"))
1611 ;; (defvar anything-w3m-bookmarks-regexp ">[^><]+[^</a>]+[a-z)0-9]+")
1613 (defface anything-w3m-bookmarks-face
'((t (:foreground
"cyan1" :underline t
)))
1614 "Face for w3m bookmarks" :group
'anything
)
1616 (defvar anything-w3m-bookmarks-regexp
">[^><]+.[^</a>]")
1617 (defun anything-w3m-bookmarks-to-alist ()
1618 (let (bookmarks-alist url title
)
1620 (insert-file-contents w3m-bookmark-file
) ;; or w3m-bookmark-file
1621 (goto-char (point-min))
1624 (when (re-search-forward "href=" nil t
)
1626 (when (re-search-forward "\\(http\\|file\\)://[^>]*" nil t
)
1627 (setq url
(concat "\"" (match-string 0))))
1629 (when (re-search-forward anything-w3m-bookmarks-regexp nil t
)
1630 (setq title
(match-string 0)))
1631 (push (cons title url
) bookmarks-alist
))))
1632 (reverse bookmarks-alist
)))
1634 (defvar anything-c-w3m-bookmarks-alist nil
)
1635 (defvar anything-c-source-w3m-bookmarks
1636 '((name .
"W3m Bookmarks")
1638 (setq anything-c-w3m-bookmarks-alist
1639 (anything-w3m-bookmarks-to-alist))))
1640 (candidates .
(lambda ()
1642 anything-c-w3m-bookmarks-alist
)))
1643 (candidate-transformer anything-c-highlight-w3m-bookmarks
)
1644 (action .
(("Browse Url" .
(lambda (candidate)
1645 (anything-c-w3m-browse-bookmark candidate
)))
1646 ("Copy Url" .
(lambda (elm)
1647 (kill-new (anything-c-w3m-bookmarks-get-value elm
))))
1648 ("Browse Url Firefox" .
(lambda (candidate)
1649 (anything-c-w3m-browse-bookmark candidate t
)))
1650 ("Delete Bookmark" .
(lambda (candidate)
1651 (anything-c-w3m-delete-bookmark candidate
)))
1652 ("Rename Bookmark" .
(lambda (candidate)
1653 (anything-c-w3m-rename-bookmark candidate
)))))
1654 (persistent-action .
(lambda (candidate)
1655 (if current-prefix-arg
1656 (anything-c-w3m-browse-bookmark candidate t
)
1657 (anything-c-w3m-browse-bookmark candidate nil t
))))
1660 ;; (anything 'anything-c-source-w3m-bookmarks)
1662 (defun anything-c-w3m-bookmarks-get-value (elm)
1663 (replace-regexp-in-string "\"" ""
1665 anything-c-w3m-bookmarks-alist
))))
1668 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab
)
1669 (let* ((fn (if use-firefox
1672 (arg (and (eq fn
'w3m-browse-url
)
1674 (funcall fn
(anything-c-w3m-bookmarks-get-value elm
) arg
)))
1677 (defun anything-c-highlight-w3m-bookmarks (books)
1678 (loop for i in books
1679 collect
(propertize i
1680 'face
'anything-w3m-bookmarks-face
1681 'help-echo
(anything-c-w3m-bookmarks-get-value i
))))
1684 (defun anything-c-w3m-delete-bookmark (elm)
1686 (find-file-literally w3m-bookmark-file
)
1687 (goto-char (point-min))
1688 (when (re-search-forward elm nil t
)
1690 (delete-region (point)
1691 (line-end-position))
1692 (delete-blank-lines))
1693 (save-buffer (current-buffer))
1694 (kill-buffer (current-buffer))))
1696 (defun anything-c-w3m-rename-bookmark (elm)
1697 (let* ((old-title (replace-regexp-in-string ">" "" elm
))
1698 (new-title (read-string "NewTitle: " old-title
)))
1700 (find-file-literally w3m-bookmark-file
)
1701 (goto-char (point-min))
1702 (when (re-search-forward (concat elm
"<") nil t
)
1703 (goto-char (1- (point)))
1704 (delete-backward-char (length old-title
))
1706 (save-buffer (current-buffer))
1707 (kill-buffer (current-buffer)))))
1710 ;;; Elisp library scan
1711 (defvar anything-c-source-elisp-library-scan
1712 '((name .
"Elisp libraries (Scan)")
1713 (init .
(anything-c-elisp-library-scan-init))
1714 (candidates-in-buffer)
1715 (action ("Find library" .
(lambda (candidate)
1716 (find-file (find-library-name candidate
))))
1717 ("Find library other window" .
(lambda (candidate)
1718 (find-file-other-window (find-library-name candidate
))))
1719 ("Load library" .
(lambda (candidate)
1720 (load-library candidate
))))))
1721 ;; (anything 'anything-c-source-elisp-library-scan)
1723 (defun anything-c-elisp-library-scan-init ()
1724 "Init anything buffer status."
1725 (let ((anything-buffer (anything-candidate-buffer 'global
))
1726 (library-list (anything-c-elisp-library-scan-list)))
1727 (with-current-buffer anything-buffer
1728 (dolist (library library-list
)
1729 (insert (format "%s\n" library
))))))
1731 (defun anything-c-elisp-library-scan-list (&optional dirs string
)
1732 "Do completion for file names passed to `locate-file'.
1733 DIRS is directory to search path.
1734 STRING is string to match."
1735 ;; Use `load-path' as path when ignore `dirs'.
1736 (or dirs
(setq dirs load-path
))
1737 ;; Init with blank when ignore `string'.
1738 (or string
(setq string
""))
1739 ;; Get library list.
1740 (let ((string-dir (file-name-directory string
))
1741 ;; File regexp that suffix match `load-file-rep-suffixes'.
1742 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes
)))
1747 (setq dir default-directory
))
1749 (setq dir
(expand-file-name string-dir dir
)))
1750 (when (file-directory-p dir
)
1751 (dolist (file (file-name-all-completions
1752 (file-name-nondirectory string
) dir
))
1753 ;; Suffixes match `load-file-rep-suffixes'.
1754 (setq name
(if string-dir
(concat string-dir file
) file
))
1755 (if (string-match match-regexp name
)
1756 (add-to-list 'names name
)))))
1761 (defvar anything-c-imenu-delimiter
" / ")
1763 (defvar anything-c-imenu-index-filter nil
)
1764 (make-variable-buffer-local 'anything-c-imenu-index-filter
)
1766 (defvar anything-c-cached-imenu-alist nil
)
1767 (make-variable-buffer-local 'anything-c-cached-imenu-alist
)
1769 (defvar anything-c-cached-imenu-candidates nil
)
1770 (make-variable-buffer-local 'anything-c-cached-imenu-candidates
)
1772 (defvar anything-c-cached-imenu-tick nil
)
1773 (make-variable-buffer-local 'anything-c-cached-imenu-tick
)
1775 (eval-when-compile (require 'imenu
))
1776 (setq imenu-auto-rescan t
)
1778 (defun anything-imenu-create-candidates (entry)
1779 "Create candidates with ENTRY."
1780 (if (listp (cdr entry
))
1781 (mapcan (lambda (sub)
1782 (if (consp (cdr sub
))
1785 (concat (car entry
) anything-c-imenu-delimiter subentry
))
1786 (anything-imenu-create-candidates sub
))
1787 (list (concat (car entry
) anything-c-imenu-delimiter
(car sub
)))))
1791 (defvar anything-c-source-imenu
1793 (candidates . anything-c-imenu-candidates
)
1795 (persistent-action .
(lambda (elm)
1796 (anything-c-imenu-default-action elm
)
1797 (unless (fboundp 'semantic-imenu-tag-overlay
)
1798 (anything-match-line-color-current-line))))
1799 (action . anything-c-imenu-default-action
))
1800 "See (info \"(emacs)Imenu\")")
1802 ;; (anything 'anything-c-source-imenu)
1804 (defun anything-c-imenu-candidates ()
1805 (with-current-buffer anything-current-buffer
1806 (let ((tick (buffer-modified-tick)))
1807 (if (eq anything-c-cached-imenu-tick tick
)
1808 anything-c-cached-imenu-candidates
1809 (setq imenu--index-alist nil
)
1810 (setq anything-c-cached-imenu-tick tick
1811 anything-c-cached-imenu-candidates
1814 'anything-imenu-create-candidates
1815 (setq anything-c-cached-imenu-alist
1816 (let ((index (imenu--make-index-alist)))
1817 (if anything-c-imenu-index-filter
1818 (funcall anything-c-imenu-index-filter index
)
1821 (setq anything-c-cached-imenu-candidates
1822 (mapcar #'(lambda (x)
1826 anything-c-cached-imenu-candidates
))))))
1828 (setq imenu-default-goto-function
'imenu-default-goto-function
)
1829 (defun anything-c-imenu-default-action (elm)
1830 "The default action for `anything-c-source-imenu'."
1831 (let ((path (split-string elm anything-c-imenu-delimiter
))
1832 (alist anything-c-cached-imenu-alist
))
1833 (if (> (length path
) 1)
1835 (setq alist
(assoc (car path
) alist
))
1836 (setq elm
(cadr path
))
1837 (imenu (assoc elm alist
)))
1838 (imenu (assoc elm alist
)))))
1841 (defvar anything-c-ctags-modes
1842 '( c-mode c
++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
1843 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
1844 scheme-mode sh-mode slang-mode sql-mode tcl-mode
))
1846 (defun anything-c-source-ctags-init ()
1847 (when (and buffer-file-name
1848 (memq major-mode anything-c-ctags-modes
)
1849 (anything-current-buffer-is-modified))
1850 (with-current-buffer (anything-candidate-buffer 'local
)
1851 (call-process-shell-command
1852 (if (string-match "\\.el\\.gz$" anything-buffer-file-name
)
1853 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) " anything-buffer-file-name
)
1854 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name
))
1855 nil
(current-buffer))
1856 (goto-char (point-min))
1858 (delete-region (point-min) (point))
1859 (loop while
(and (not (eobp)) (search-forward "\001" (point-at-eol) t
))
1860 for lineno-start
= (point)
1861 for lineno
= (buffer-substring lineno-start
(1- (search-forward "," (point-at-eol) t
)))
1864 (insert (format "%5s:" lineno
))
1865 (search-forward "\177" (point-at-eol) t
)
1866 (delete-region (1- (point)) (point-at-eol))
1867 (forward-line 1)))))
1869 (defvar anything-c-source-ctags
1870 '((name .
"Exuberant ctags")
1871 (init . anything-c-source-ctags-init
)
1872 (candidates-in-buffer)
1875 "Needs Exuberant Ctags.
1877 http://ctags.sourceforge.net/")
1878 ;; (anything 'anything-c-source-ctags)
1881 (eval-when-compile (require 'semantic nil t
))
1882 (defun anything-semantic-construct-candidates (tags depth
)
1883 (when (require 'semantic nil t
)
1885 (mapcar (lambda (tag)
1887 (let ((type (semantic-tag-type tag
))
1888 (class (semantic-tag-class tag
)))
1889 (if (or (and (stringp type
)
1890 (string= type
"class"))
1891 (eq class
'function
)
1892 (eq class
'variable
))
1893 (cons (cons (concat (make-string (* depth
2) ?\s
)
1894 (semantic-format-tag-summarize tag nil t
)) tag
)
1895 (anything-semantic-construct-candidates (semantic-tag-components tag
)
1899 (defun anything-semantic-default-action (candidate)
1900 (let ((tag (cdr (assoc candidate anything-semantic-candidates
))))
1901 (semantic-go-to-tag tag
)))
1903 (defvar anything-c-source-semantic
1904 '((name .
"Semantic Tags")
1906 (setq anything-semantic-candidates
1908 (anything-semantic-construct-candidates (semantic-fetch-tags) 0)
1910 (candidates .
(lambda ()
1911 (if anything-semantic-candidates
1912 (mapcar 'car anything-semantic-candidates
))))
1913 (persistent-action .
(lambda (elm)
1914 (anything-semantic-default-action elm
)
1915 (anything-match-line-color-current-line)))
1916 (action . anything-semantic-default-action
)
1917 "Needs semantic in CEDET.
1919 http://cedet.sourceforge.net/semantic.shtml
1920 http://cedet.sourceforge.net/"))
1922 ;; (anything 'anything-c-source-semantic)
1924 ;;; Function is called by
1925 (defvar anything-c-source-simple-call-tree-functions-callers
1926 '((name .
"Function is called by")
1927 (init . anything-c-simple-call-tree-functions-callers-init
)
1929 (candidates-in-buffer))
1930 "Needs simple-call-tree.el.
1931 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
1933 (defun anything-c-simple-call-tree-functions-callers-init ()
1934 (require 'simple-call-tree
)
1936 (when (anything-current-buffer-is-modified)
1937 (simple-call-tree-analyze)
1938 (let ((list (simple-call-tree-invert simple-call-tree-alist
)))
1939 (with-current-buffer (anything-candidate-buffer 'local
)
1940 (dolist (entry list
)
1941 (let ((callers (mapconcat #'identity
(cdr entry
) ", ")))
1942 (insert (car entry
) " is called by "
1943 (if (string= callers
"")
1947 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
1950 (defvar anything-c-source-simple-call-tree-callers-functions
1951 '((name .
"Function calls")
1952 (init . anything-c-simple-call-tree-callers-functions-init
)
1954 (candidates-in-buffer))
1955 "Needs simple-call-tree.el.
1956 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
1958 (defun anything-c-simple-call-tree-callers-functions-init ()
1959 (require 'simple-call-tree
)
1961 (when (anything-current-buffer-is-modified)
1962 (simple-call-tree-analyze)
1963 (let ((list simple-call-tree-alist
))
1964 (with-current-buffer (anything-candidate-buffer 'local
)
1965 (dolist (entry list
)
1966 (let ((functions (mapconcat #'identity
(cdr entry
) ", ")))
1967 (insert (car entry
) " calls "
1968 (if (string= functions
"")
1973 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
1975 ;;; Commands/Options with doc
1976 (defvar anything-c-auto-document-data nil
)
1977 (make-variable-buffer-local 'anything-c-auto-document-data
)
1978 (defvar anything-c-source-commands-and-options-in-file
1979 '((name .
"Commands/Options in file")
1981 .
(lambda (x) (format "Commands/Options in %s"
1982 (buffer-local-value 'buffer-file-name anything-current-buffer
))))
1983 (candidates . anything-command-and-options-candidates
)
1986 "List Commands and Options with doc. It needs auto-document.el .
1988 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
1990 (eval-when-compile (require 'auto-document nil t
))
1991 (defun anything-command-and-options-candidates ()
1992 (with-current-buffer anything-current-buffer
1993 (when (and (require 'auto-document nil t
)
1994 (eq major-mode
'emacs-lisp-mode
)
1995 (or (anything-current-buffer-is-modified)
1996 (not anything-c-auto-document-data
)))
1997 (or imenu--index-alist
(imenu--make-index-alist t
))
1998 (setq anything-c-auto-document-data
1999 (destructuring-bind (commands options
)
2000 (adoc-construct anything-current-buffer
)
2002 (loop for
(command . doc
) in commands
2003 for cmdname
= (symbol-name command
)
2005 (cons (format "Command: %s\n %s"
2006 (propertize cmdname
'face font-lock-function-name-face
)
2007 (adoc-first-line doc
))
2008 (assoc cmdname imenu--index-alist
)))
2009 (loop with var-alist
= (cdr (assoc "Variables" imenu--index-alist
))
2010 for
(option doc default
) in options
2011 for optname
= (symbol-name option
)
2013 (cons (format "Option: %s\n %s\n default = %s"
2014 (propertize optname
'face font-lock-variable-name-face
)
2015 (adoc-first-line doc
)
2016 (adoc-prin1-to-string default
))
2019 anything-c-auto-document-data
))
2021 ;; (anything 'anything-c-source-commands-and-options-in-file)
2023 ;;;; <Color and Face>
2025 (defvar anything-c-source-customize-face
2026 '((name .
"Customize Face")
2028 (unless (anything-candidate-buffer)
2029 (save-window-excursion (list-faces-display))
2030 (anything-candidate-buffer (get-buffer "*Faces*")))))
2031 (candidates-in-buffer)
2032 (get-line . buffer-substring
)
2033 (action .
(lambda (line)
2034 (customize-face (intern (car (split-string line
))))))
2035 (requires-pattern .
3))
2036 "See (info \"(emacs)Faces\")")
2037 ;; (anything 'anything-c-source-customize-face)
2040 (defvar anything-c-source-colors
2042 (init .
(lambda () (unless (anything-candidate-buffer)
2043 (save-window-excursion (list-colors-display))
2044 (anything-candidate-buffer (get-buffer "*Colors*")))))
2045 (candidates-in-buffer)
2046 (get-line . buffer-substring
)
2047 (action ("Copy Name" .
(lambda (candidate)
2048 (kill-new (anything-c-colors-get-name candidate
))))
2049 ("Copy RGB" .
(lambda (candidate)
2050 (kill-new (anything-c-colors-get-rgb candidate
))))
2051 ("Insert Name" .
(lambda (candidate)
2052 (with-current-buffer anything-current-buffer
2053 (insert (anything-c-colors-get-name candidate
)))))
2054 ("Insert RGB" .
(lambda (candidate)
2055 (with-current-buffer anything-current-buffer
2056 (insert (anything-c-colors-get-rgb candidate
))))))
2057 (requires-pattern .
3)))
2058 ;; (anything 'anything-c-source-colors)
2060 (defun anything-c-colors-get-name (candidate)
2062 (replace-regexp-in-string
2065 (insert (capitalize candidate
))
2066 (goto-char (point-min))
2067 (search-forward-regexp "\\s-\\{2,\\}")
2071 (defun anything-c-colors-get-rgb (candidate)
2073 (replace-regexp-in-string
2076 (insert (capitalize candidate
))
2077 (goto-char (point-max))
2078 (search-backward-regexp "\\s-\\{2,\\}")
2079 (kill-region (point) (point-min))
2082 ;;;; <Search Engine>
2083 ;;; Tracker desktop search
2084 (defvar anything-c-source-tracker-search
2085 '((name .
"Tracker Search")
2086 (candidates .
(lambda ()
2087 (start-process "tracker-search-process" nil
2091 (requires-pattern .
3)
2093 "Source for retrieving files matching the current input pattern
2094 with the tracker desktop search.")
2095 ;; (anything 'anything-c-source-tracker-search)
2097 ;;; Spotlight (MacOS X desktop search)
2098 (defvar anything-c-source-mac-spotlight
2100 (candidates .
(lambda ()
2101 (start-process "mdfind-process" nil
"mdfind" anything-pattern
)))
2103 (requires-pattern .
3)
2105 "Source for retrieving files via Spotlight's command line
2107 ;; (anything 'anything-c-source-mac-spotlight)
2111 ;; See: http://www.emacswiki.org/emacs-en/Icicles_-_Multiple_Regions
2112 ;; That is the anything interface.
2114 (defvar anything-icicle-region-alist nil
)
2115 (defvar anything-c-source-icicle-region
2116 '((name .
"Icicle Regions")
2118 (setq anything-icicle-region-alist
2120 for i in icicle-region-alist
2121 collect
(concat (car i
) " => " (cadr i
))))))
2122 (candidates . anything-icicle-region-alist
)
2123 (action .
(("Go to region" . anything-c-icicle-region-goto-region
)
2124 ("Insert region at point" .
(lambda (elm)
2126 (save-window-excursion
2127 (anything-c-icicle-region-goto-region elm
)
2128 (setq reg
(buffer-substring (mark) (point))))
2130 ("Remove region" . anything-c-icicle-region-delete-region
)
2131 ("Update" .
(lambda (elm)
2132 (icicle-purge-bad-file-regions)))))))
2134 ;; (anything 'anything-c-source-icicle-region)
2136 (defun anything-icicle-select-region-action (pos)
2137 "Go to the region at nth `pos' in `icicle-region-alist'.
2138 See `icicle-select-region-action'."
2139 (let ((icicle-get-alist-candidate-function #'(lambda (pos)
2140 (nth pos icicle-region-alist
))))
2141 (icicle-select-region-action pos
)))
2143 (defun anything-icicle-delete-region-from-alist (pos)
2144 "Delete the region at nth `pos' from `icicle-region-alist'.
2145 See `icicle-delete-region-from-alist'."
2146 (let ((alist-cand (nth pos icicle-region-alist
)))
2147 (setq icicle-region-alist
2148 (delete alist-cand icicle-region-alist
)))
2149 (funcall icicle-customize-save-variable-function
'icicle-region-alist icicle-region-alist
))
2151 (defun anything-c-icicle-region-goto-region (candidate)
2152 "Get the position of `candidate' and call `anything-icicle-select-region-action'."
2153 (let ((pos (position candidate anything-icicle-region-alist
))
2154 (buf (second (split-string candidate
" => "))))
2155 (if (equal buf
"*info*")
2156 (info (caddr (nth pos icicle-region-alist
))))
2157 (anything-icicle-select-region-action pos
)))
2159 (defun anything-c-icicle-region-delete-region (candidate)
2160 "Get the position of `candidate' and call `anything-icicle-delete-region-from-alist'."
2161 (let ((pos (position candidate anything-icicle-region-alist
)))
2162 (anything-icicle-delete-region-from-alist pos
)))
2167 (defvar anything-c-source-kill-ring
2168 '((name .
"Kill Ring")
2169 (init .
(lambda () (anything-attrset 'last-command last-command
)))
2170 (candidates .
(lambda ()
2171 (loop for kill in kill-ring
2172 unless
(or (< (length kill
) anything-kill-ring-threshold
)
2173 (string-match "^[\\s\\t]+$" kill
))
2175 (action . anything-c-kill-ring-action
)
2179 "Source for browse and insert contents of kill-ring.")
2181 (defun anything-c-kill-ring-action (str)
2182 "Insert STR in `kill-ring' and set STR to the head.
2183 If this action is executed just after `yank', replace with STR as yanked string."
2184 (setq kill-ring
(delete str kill-ring
))
2185 (if (not (eq (anything-attr 'last-command
) 'yank
))
2186 (insert-for-yank str
)
2188 (let ((inhibit-read-only t
)
2189 (before (< (point) (mark t
))))
2191 (funcall (or yank-undo-function
'delete-region
) (point) (mark t
))
2192 (funcall (or yank-undo-function
'delete-region
) (mark t
) (point)))
2193 (setq yank-undo-function nil
)
2194 (set-marker (mark-marker) (point) (current-buffer))
2195 (insert-for-yank str
)
2196 ;; Set the window start back where it was in the yank command,
2198 (set-window-start (selected-window) yank-window-start t
)
2200 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
2201 ;; It is cleaner to avoid activation, even though the command
2202 ;; loop would deactivate the mark because we inserted text.
2203 (goto-char (prog1 (mark t
)
2204 (set-marker (mark-marker) (point) (current-buffer)))))))
2207 ;; (anything 'anything-c-source-kill-ring)
2210 ;; DO NOT include these sources in `anything-sources' use
2211 ;; the commands `anything-mark-ring' and `anything-global-mark-ring' instead.
2213 (defun anything-c-source-mark-ring-candidates ()
2214 (flet ((get-marks (pos)
2218 (let ((line (car (split-string (thing-at-point 'line
) "[\n\r]"))))
2219 (when (string= "" line
)
2220 (setq line
"<EMPTY LINE>"))
2221 (format "%7d: %s" (line-number-at-pos) line
)))))
2222 (with-current-buffer anything-current-buffer
2224 with marks
= (cons (mark-marker) mark-ring
)
2227 for f
= (get-marks i
)
2228 if
(not (member f recip
))
2231 finally
(return (reverse recip
))))))
2233 (defvar anything-mark-ring-cache nil
)
2234 (defvar anything-c-source-mark-ring
2235 '((name .
"mark-ring")
2237 (setq anything-mark-ring-cache
2238 (anything-c-source-mark-ring-candidates))))
2239 (candidates .
(lambda ()
2240 (anything-aif anything-mark-ring-cache
2242 (action .
(("Goto line" .
(lambda (candidate)
2243 (goto-line (string-to-number candidate
))))))
2244 (persistent-action .
(lambda (candidate)
2245 (goto-line (string-to-number candidate
))
2246 (anything-match-line-color-current-line)))))
2248 ;; (anything 'anything-c-source-mark-ring)
2250 (defun anything-mark-ring ()
2251 "Preconfigured `anything' for `anything-c-source-mark-ring'."
2253 (anything 'anything-c-source-mark-ring
))
2255 ;;; Global-mark-ring
2256 (defvar anything-c-source-global-mark-ring
2257 '((name .
"global-mark-ring")
2258 (candidates . anything-c-source-global-mark-ring-candidates
)
2259 (action .
(("Goto line" .
(lambda (candidate)
2260 (let ((items (split-string candidate
":")))
2261 (switch-to-buffer (second items
))
2262 (goto-line (string-to-number (car items
))))))))
2263 (persistent-action .
(lambda (candidate)
2264 (let ((items (split-string candidate
":")))
2265 (switch-to-buffer (second items
))
2266 (goto-line (string-to-number (car items
)))
2267 (anything-match-line-color-current-line))))))
2269 (defun anything-c-source-global-mark-ring-candidates ()
2271 (with-current-buffer (marker-buffer m
)
2275 (if (string= "" line
)
2276 (setq line
"<EMPTY LINE>")
2277 (setq line
(car (split-string (thing-at-point 'line
) "[\n\r]"))))
2278 (format "%7d:%s: %s" (line-number-at-pos) (marker-buffer m
) line
)))))
2280 with marks
= global-mark-ring
2283 if
(not (or (string-match "^ " (format "%s" (marker-buffer i
)))
2284 (null (marker-buffer i
))))
2286 if
(and a
(not (member a recip
)))
2289 finally
(return (reverse recip
)))))
2291 ;; (anything 'anything-c-source-global-mark-ring)
2293 (defun anything-global-mark-ring ()
2294 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
2296 (anything 'anything-c-source-global-mark-ring
))
2299 ;;; Insert from register
2300 (defvar anything-c-source-register
2301 '((name .
"Registers")
2302 (candidates . anything-c-register-candidates
)
2303 (action-transformer . anything-c-register-action-transformer
)
2306 "See (info \"(emacs)Registers\")")
2308 (defun anything-c-register-candidates ()
2309 "Collecting register contents and appropriate commands."
2310 (loop for
(char . val
) in register-alist
2311 for key
= (single-key-description char
)
2312 for string-actions
= (cond
2314 (list (int-to-string val
)
2316 'increment-register
))
2318 (let ((buf (marker-buffer val
)))
2320 (list "a marker in no buffer")
2322 "a buffer position:"
2325 (int-to-string (marker-position val
)))
2327 'insert-register
))))
2328 ((and (consp val
) (window-configuration-p (car val
)))
2329 (list "window configuration."
2331 ((and (consp val
) (frame-configuration-p (car val
)))
2332 (list "frame configuration."
2334 ((and (consp val
) (eq (car val
) 'file
))
2335 (list (concat "file:"
2336 (prin1-to-string (cdr val
))
2339 ((and (consp val
) (eq (car val
) 'file-query
))
2340 (list (concat "file:a file-query reference: file "
2343 (int-to-string (car (cdr (cdr val
))))
2347 (let ((lines (format "%4d" (length val
))))
2348 (list (format "%s: %s\n" lines
2349 (truncate-string-to-width
2350 (mapconcat 'identity
(list (car val
))
2351 ;; (mapconcat (lambda (y) y) val
2352 "^J") (- (window-width) 15)))
2355 (list ;; without properties
2356 (substring-no-properties val
)
2359 'prepend-to-register
))
2362 collect
(cons (format "register %3s: %s" key
(car string-actions
))
2363 (cons char
(cdr string-actions
)))))
2365 (defun anything-c-register-action-transformer (actions register-and-functions
)
2366 "Decide actions by the contents of register."
2367 (loop with func-actions
=
2370 (lambda (c) (insert-register (car c
))))
2372 "Jump to Register" .
2373 (lambda (c) (jump-to-register (car c
))))
2375 "Append Region to Register" .
2376 (lambda (c) (append-to-register (car c
) (region-beginning) (region-end))))
2377 (prepend-to-register
2378 "Prepend Region to Register" .
2379 (lambda (c) (prepend-to-register (car c
) (region-beginning) (region-end))))
2381 "Increment Prefix Arg to Register" .
2382 (lambda (c) (increment-register anything-current-prefix-arg
(car c
)))))
2383 for func in
(cdr register-and-functions
)
2384 for cell
= (assq func func-actions
)
2386 collect
(cdr cell
)))
2388 ;; (anything 'anything-c-source-register)
2390 ;;;; <Headline Extraction>
2391 (defvar anything-c-source-fixme
2392 '((name .
"TODO/FIXME/DRY comments")
2393 (headline .
"^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
2396 "Show TODO/FIXME/DRY comments in current file.")
2397 ;; (anything 'anything-c-source-fixme)
2399 (defvar anything-c-source-rd-headline
2400 '((name .
"RD HeadLine")
2401 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
2402 (condition .
(memq major-mode
'(rdgrep-mode rd-mode
)))
2408 http://en.wikipedia.org/wiki/Ruby_Document_format")
2409 ;; (anything 'anything-c-source-rd-headline)
2411 (defvar anything-c-source-oddmuse-headline
2412 '((name .
"Oddmuse HeadLine")
2413 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
2414 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
2415 (condition .
(memq major-mode
'(oddmuse-mode yaoddmuse-mode
)))
2418 "Show Oddmuse headlines, such as EmacsWiki.")
2419 ;; (anything 'anything-c-source-oddmuse-headline)
2421 (defvar anything-c-source-emacs-source-defun
2422 '((name .
"Emacs Source DEFUN")
2423 (headline .
"DEFUN\\|DEFVAR")
2424 (condition .
(string-match "/emacs2[0-9].+/src/.+c$" (or buffer-file-name
""))))
2425 "Show DEFUN/DEFVAR in Emacs C source file.")
2426 ;; (anything 'anything-c-source-emacs-source-defun)
2428 (defvar anything-c-source-emacs-lisp-expectations
2429 '((name .
"Emacs Lisp Expectations")
2430 (headline .
"(desc[ ]\\|(expectations")
2431 (condition .
(eq major-mode
'emacs-lisp-mode
)))
2432 "Show descriptions (desc) in Emacs Lisp Expectations.
2434 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
2435 ;; (anything 'anything-c-source-emacs-lisp-expectations)
2437 (defvar anything-c-source-emacs-lisp-toplevels
2438 '((name .
"Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
2439 (headline .
"^(\\|(@\\*\\|^;;;;")
2440 (get-line . buffer-substring
)
2441 (condition .
(eq major-mode
'emacs-lisp-mode
))
2443 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
2444 linkd.el is optional because linkd stars are extracted by regexp.
2445 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
2446 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
2448 (defvar anything-c-source-org-headline
2449 '((name .
"Org HeadLine")
2451 "^\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2452 "^\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2453 "^\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2454 "^\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2455 "^\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2456 "^\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2457 "^\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$"
2458 "^\\*\\*\\*\\*\\*\\*\\*\\* \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
2459 (condition .
(eq major-mode
'org-mode
))
2462 (persistent-action .
(lambda (elm)
2463 (anything-c-action-line-goto elm
)
2466 .
(lambda (actions candidate
)
2467 '(("Go to Line" . anything-c-action-line-goto
)
2468 ("Insert Link to This Headline" . anything-c-org-headline-insert-link-to-headline
)))))
2469 "Show Org headlines.
2470 org-mode is very very much extended text-mode/outline-mode.
2472 See (find-library \"org.el\")
2473 See http://orgmode.org for the latest version.")
2475 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
2478 (goto-line (car lineno-and-content
))
2479 (and (looking-at "^\\*+ \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
2480 (org-make-link-string (concat "*" (match-string 1)))))))
2482 ;; (anything 'anything-c-source-org-headline)
2484 ;;; Anything yaoddmuse
2485 ;; Be sure to have yaoddmuse.el installed
2486 ;; install-elisp may be required if you want to install elisp file from here.
2487 (defvar anything-yaoddmuse-use-cache-file nil
)
2488 (defvar anything-c-yaoddmuse-cache-file
"~/.emacs.d/yaoddmuse-cache.el")
2489 (defvar anything-c-yaoddmuse-ew-cache nil
)
2490 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
2491 '((name .
"Yaoddmuse Edit or View (EmacsWiki)")
2492 (candidates .
(lambda ()
2493 (if anything-yaoddmuse-use-cache-file
2496 (unless anything-c-yaoddmuse-ew-cache
2497 (load anything-c-yaoddmuse-cache-file
)
2498 (setq anything-c-yaoddmuse-ew-cache
2499 (gethash "EmacsWiki" yaoddmuse-pages-hash
)))
2500 anything-c-yaoddmuse-ew-cache
)
2502 (yaoddmuse-update-pagename t
)
2503 (gethash "EmacsWiki" yaoddmuse-pages-hash
))))
2504 (action .
(("Edit page" .
(lambda (candidate)
2505 (yaoddmuse-edit "EmacsWiki" candidate
)))
2506 ("Browse page" .
(lambda (candidate)
2507 (yaoddmuse-browse-page "EmacsWiki" candidate
)))
2508 ("Browse page other window" .
(lambda (candidate)
2510 (split-window-vertically))
2511 (yaoddmuse-browse-page "EmacsWiki" candidate
)))
2512 ("Browse diff" .
(lambda (candidate)
2513 (yaoddmuse-browse-page-diff "EmacsWiki" candidate
)))
2514 ("Copy URL" .
(lambda (candidate)
2515 (kill-new (yaoddmuse-url "EmacsWiki" candidate
))
2516 (message "Have copy page %s's URL to yank." candidate
)))
2517 ("Create page" .
(lambda (candidate)
2518 (yaoddmuse-edit "EmacsWiki" anything-input
)))
2519 ("Update cache" .
(lambda (candidate)
2520 (if anything-yaoddmuse-use-cache-file
2522 (anything-yaoddmuse-cache-pages t
)
2523 (setq anything-c-yaoddmuse-ew-cache
2524 (gethash "EmacsWiki" yaoddmuse-pages-hash
)))
2525 (yaoddmuse-update-pagename))))))
2526 (action-transformer anything-c-yaoddmuse-action-transformer
)))
2528 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
2530 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
2531 '((name .
"Yaoddmuse Post library (EmacsWiki)")
2532 (init .
(anything-yaoddmuse-init))
2533 (candidates-in-buffer)
2534 (action .
(("Post library and Browse" .
(lambda (candidate)
2535 (yaoddmuse-post-file (find-library-name candidate
)
2537 (file-name-nondirectory (find-library-name candidate
))
2539 ("Post library" .
(lambda (candidate)
2540 (yaoddmuse-post-file (find-library-name candidate
)
2542 (file-name-nondirectory (find-library-name candidate
)))))))))
2544 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
2546 (defun anything-c-yaoddmuse-action-transformer (actions candidate
)
2547 "Allow the use of `install-elisp' only on elisp files."
2548 (if (string-match "\.el$" candidate
)
2549 (append actions
'(("Install Elisp" .
(lambda (elm)
2550 (install-elisp-from-emacswiki elm
)))))
2553 (defun anything-yaoddmuse-cache-pages (&optional load
)
2554 "Fetch the list of files on emacswiki and create cache file.
2555 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
2557 (yaoddmuse-update-pagename)
2559 (find-file anything-c-yaoddmuse-cache-file
)
2561 (insert "(puthash \"EmacsWiki\" '(")
2562 (loop for i in
(gethash "EmacsWiki" yaoddmuse-pages-hash
)
2564 (insert (concat "(\"" (car i
) "\") ")))
2565 (insert ") yaoddmuse-pages-hash)\n")
2567 (kill-buffer (current-buffer))
2568 (when (or current-prefix-arg
2570 (load anything-c-yaoddmuse-cache-file
))))
2572 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
2573 "Edit or View EmacsWiki page."
2575 (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view
))
2577 (defun anything-yaoddmuse-emacswiki-post-library ()
2578 "Post library to EmacsWiki."
2580 (anything 'anything-c-source-yaoddmuse-emacswiki-post-library
))
2582 (defun anything-yaoddmuse-init ()
2583 "Init anything buffer status."
2584 (let ((anything-buffer (anything-candidate-buffer 'global
))
2585 (library-list (yaoddmuse-get-library-list)))
2586 (with-current-buffer anything-buffer
2587 ;; Insert library name.
2588 (dolist (library library-list
)
2589 (insert (format "%s\n" library
)))
2591 (sort-lines nil
(point-min) (point-max)))))
2594 (defvar anything-c-source-eev-anchor
2595 '((name .
"Anchors")
2597 (setq anything-c-eev-anchor-buffer
2599 (candidates .
(lambda ()
2602 (with-current-buffer anything-c-eev-anchor-buffer
2603 (goto-char (point-min))
2605 (while (re-search-forward (format ee-anchor-format
"\\([^\.].+\\)") nil t
)
2606 (push (match-string-no-properties 1) anchors
))
2607 (setq anchors
(reverse anchors
)))))
2609 (persistent-action .
(lambda (item)
2611 (anything-match-line-color-current-line)))
2612 (action .
(("Goto link" .
(lambda (item)
2615 ;; (anything 'anything-c-source-eev-anchor)
2619 (defvar anything-c-source-picklist
2620 '((name .
"Picklist")
2621 (candidates .
(lambda () (mapcar 'car picklist-list
)))
2624 ;; (anything 'anything-c-source-picklist)
2627 (defun anything-c-bbdb-candidates ()
2628 "Return a list of all names in the bbdb database. The format
2629 is \"Firstname Lastname\"."
2630 (mapcar (lambda (bbdb-record)
2631 (replace-regexp-in-string
2633 (concat (aref bbdb-record
0) " " (aref bbdb-record
1))))
2636 (defun anything-c-bbdb-create-contact (actions candidate
)
2637 "Action transformer that returns only an entry to add the
2638 current `anything-pattern' as new contact. All other actions are
2640 (if (string= candidate
"*Add to contacts*")
2641 '(("Add to contacts" .
(lambda (actions)
2642 (bbdb-create-internal
2643 (read-from-minibuffer "Name: " anything-c-bbdb-name
)
2644 (read-from-minibuffer "Company: ")
2645 (read-from-minibuffer "Email: ")
2648 (read-from-minibuffer "Note: ")))))
2651 (defun anything-c-bbdb-get-record (candidate)
2652 "Return record that match CANDIDATE."
2653 (bbdb candidate nil
)
2654 (set-buffer "*BBDB*")
2655 (bbdb-current-record))
2657 (defvar anything-c-bbdb-name nil
2658 "Only for internal use.")
2660 (defvar anything-c-source-bbdb
2662 (candidates . anything-c-bbdb-candidates
)
2664 (action ("Send a mail" .
(lambda (candidate)
2665 (bbdb-send-mail (anything-c-bbdb-get-record candidate
))))
2666 ("View person's data" .
(lambda (candidate)
2667 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate
)))))
2668 (filtered-candidate-transformer .
(lambda (candidates source
)
2669 (setq anything-c-bbdb-name anything-pattern
)
2670 (if (not candidates
)
2671 (list "*Add to contacts*")
2673 (action-transformer .
(lambda (actions candidate
)
2674 (anything-c-bbdb-create-contact actions candidate
)))))
2675 ;; (anything 'anything-c-source-bbdb)
2677 ;;; Evaluation Result
2678 (defvar anything-c-source-evaluation-result
2679 '((name .
"Evaluation Result")
2681 (match (lambda (candidate) t
))
2682 (candidates "dummy")
2683 (filtered-candidate-transformer .
(lambda (candidates source
)
2687 (eval (read anything-pattern
)))
2690 (action ("Do Nothing" . ignore
))))
2691 ;; (anything 'anything-c-source-evaluation-result)
2693 ;;; Calculation Result
2694 (defvar anything-c-source-calculation-result
2695 '((name .
"Calculation Result")
2697 (match (lambda (candidate) t
))
2698 (candidates "dummy")
2699 (filtered-candidate-transformer .
(lambda (candidates source
)
2702 (calc-eval anything-pattern
)
2705 (action ("Copy result to kill-ring" . kill-new
))))
2706 ;; (anything 'anything-c-source-calculation-result)
2708 ;;; Google Suggestions
2709 (defvar anything-c-source-google-suggest
2710 '((name .
"Google Suggest")
2711 (candidates .
(lambda ()
2712 (let ((suggestions (anything-c-google-suggest-fetch anything-input
)))
2713 (if (some (lambda (suggestion)
2714 (equal (cdr suggestion
) anything-input
))
2717 ;; if there is no suggestion exactly matching the input then
2718 ;; prepend a Search on Google item to the list
2719 (append (list (cons (concat "Search for "
2720 "'" anything-input
"'"
2724 (action .
(("Google Search" .
2726 (browse-url (concat anything-c-google-suggest-search-url
2727 (url-hexify-string candidate
)))))))
2729 (requires-pattern .
3)
2731 ;; (anything 'anything-c-source-google-suggest)
2733 (defun anything-c-google-suggest-fetch (input)
2734 "Fetch suggestions for INPUT."
2735 (let* ((result (with-current-buffer
2736 (url-retrieve-synchronously
2737 (concat anything-c-google-suggest-url
2738 (url-hexify-string input
)))
2739 (buffer-substring (point-min) (point-max))))
2740 (split (split-string result
"new Array("))
2741 (suggestions (anything-c-google-suggest-get-items (second split
)))
2742 (numbers (anything-c-google-suggest-get-items (third split
)))
2743 (longest (+ (apply 'max
0 (let (lengths)
2744 (dotimes (i (length suggestions
))
2745 (push (+ (length (nth i suggestions
))
2746 (length (nth i numbers
)))
2751 (dotimes (i (length suggestions
))
2752 (let ((suggestion (nth i suggestions
))
2753 (number (nth i numbers
)))
2754 (push (cons (concat suggestion
2755 (make-string (- longest
2764 (defun anything-c-google-suggest-get-items (str)
2765 "Extract items from STR returned by Google Suggest."
2766 (let ((start nil
) items
)
2767 (while (string-match "\"\\([^\"]+?\\)\"" str start
)
2768 (push (match-string 1 str
) items
)
2769 (setq start
(1+ (match-end 1))))
2773 ;;; Need external program surfraw.
2774 ;;; http://surfraw.alioth.debian.org/
2776 (defvar anything-c-surfraw-favorites
'("google" "wikipedia"
2778 "codesearch" "genpkg"
2781 "All elements of this list will appear first in results.")
2782 (defvar anything-c-surfraw-use-only-favorites nil
2783 "If non-nil use only `anything-c-surfraw-favorites'.")
2786 (defun anything-c-build-elvi-alist ()
2788 A list of search engines."
2791 (call-process "surfraw" nil t nil
2793 (split-string (buffer-string) "\n")))
2796 (loop for i in elvi-list
2798 (setq line
(split-string i
))
2799 collect
(cons (first line
) (mapconcat #'(lambda (x) x
) (cdr line
) " "))))))
2802 (defun anything-c-surfraw-sort-elvi (&optional only-fav
)
2803 "Sort elvi alist according to `anything-c-surfraw-favorites'."
2804 (let* ((elvi-alist (anything-c-build-elvi-alist))
2805 (fav-alist (loop for j in anything-c-surfraw-favorites
2806 collect
(assoc j elvi-alist
)))
2807 (rest-elvi (loop for i in elvi-alist
2808 if
(not (member i fav-alist
))
2812 (append fav-alist rest-elvi
))))
2814 (defun anything-c-surfraw-get-url (engine pattern
)
2815 "Get search url from `engine' for `anything-pattern'."
2817 (apply #'call-process
"surfraw" nil t nil
2824 (defvar anything-c-surfraw-elvi nil
)
2825 (defvar anything-c-surfraw-cache nil
)
2826 (defvar anything-c-source-surfraw
2827 '((name .
"Surfraw")
2829 (unless anything-c-surfraw-cache
2830 (setq anything-c-surfraw-elvi
(anything-c-surfraw-sort-elvi
2831 anything-c-surfraw-use-only-favorites
))
2832 (setq anything-c-surfraw-cache
2833 (loop for i in anything-c-surfraw-elvi
2835 collect
(car i
))))))
2836 (candidates .
(lambda ()
2837 (loop for i in anything-c-surfraw-cache
2838 for s
= (anything-c-surfraw-get-url i anything-pattern
)
2839 collect
(concat (propertize i
2840 'face
'((:foreground
"green"))
2841 'help-echo
(cdr (assoc i anything-c-surfraw-elvi
)))
2842 ">>>" (replace-regexp-in-string "\n" "" s
)))))
2843 (action .
(("Browse" .
(lambda (candidate)
2844 (let ((url (second (split-string candidate
">>>"))))
2846 ("Browse firefox" .
(lambda (candidate)
2847 (let ((url (second (split-string candidate
">>>"))))
2848 (browse-url-firefox url t
))))))
2850 (requires-pattern .
3)
2854 ;; (anything 'anything-c-source-surfraw)
2858 (defun anything-emms-stream-edit-bookmark (elm)
2859 "Change the information of current emms-stream bookmark from anything."
2861 (let* ((cur-buf anything-current-buffer
)
2862 (bookmark (assoc elm emms-stream-list
))
2863 (name (read-from-minibuffer "Description: "
2865 (url (read-from-minibuffer "URL: "
2867 (fd (read-from-minibuffer "Feed Descriptor: "
2868 (int-to-string (nth 2 bookmark
))))
2869 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
2870 (format "%s" (car (last bookmark
))))))
2873 (when (re-search-forward (concat "^" name
) nil t
)
2875 (emms-stream-delete-bookmark)
2876 (emms-stream-add-bookmark name url
(string-to-number fd
) type
)
2877 (emms-stream-save-bookmarks-file)
2879 (switch-to-buffer cur-buf
)))))
2881 (defun anything-emms-stream-delete-bookmark (elm)
2882 "Delete an emms-stream bookmark from anything."
2884 (let* ((cur-buf anything-current-buffer
)
2885 (bookmark (assoc elm emms-stream-list
))
2886 (name (nth 0 bookmark
)))
2889 (when (re-search-forward (concat "^" name
) nil t
)
2891 (emms-stream-delete-bookmark)
2892 (emms-stream-save-bookmarks-file)
2894 (switch-to-buffer cur-buf
)))))
2896 (defvar anything-c-source-emms-streams
2897 '((name .
"Emms Streams")
2899 (emms-stream-init)))
2900 (candidates .
(lambda ()
2901 (mapcar 'car emms-stream-list
)))
2902 (action .
(("Play" .
(lambda (elm)
2903 (let* ((stream (assoc elm emms-stream-list
))
2904 (fn (intern (concat "emms-play-" (symbol-name (car (last stream
))))))
2905 (url (second stream
)))
2907 ("Delete" . anything-emms-stream-delete-bookmark
)
2908 ("Edit" . anything-emms-stream-edit-bookmark
)))
2910 ;; (anything 'anything-c-source-emms-streams)
2912 ;; Don't forget to set `emms-source-file-default-directory'
2913 (defvar anything-c-source-emms-dired
2914 '((name .
"Music Directory")
2915 (candidates .
(lambda ()
2916 (cddr (directory-files emms-source-file-default-directory
))))
2917 (action .
(("Play Directory" .
(lambda (item)
2918 (emms-play-directory
2919 (expand-file-name item
2920 emms-source-file-default-directory
))))
2921 ("Open dired in file's directory" .
(lambda (item)
2922 (anything-c-open-dired
2923 (expand-file-name item
2924 emms-source-file-default-directory
))))))
2926 ;; (anything 'anything-c-source-emms-dired)
2928 ;;; Jabber Contacts (jabber.el)
2929 (defun anything-c-jabber-online-contacts ()
2930 "List online Jabber contacts."
2933 (dolist (item (jabber-concat-rosters) jids
)
2934 (when (get item
'connected
)
2935 (push (if (get item
'name
)
2936 (cons (get item
'name
) item
)
2937 (cons (symbol-name item
) item
)) jids
))))))
2939 (defvar anything-c-source-jabber-contacts
2940 '((name .
"Jabber Contacts")
2941 (init .
(lambda () (require 'jabber
)))
2942 (candidates .
(lambda () (mapcar 'car
(anything-c-jabber-online-contacts))))
2943 (action .
(lambda (x)
2945 (jabber-read-account)
2947 (cdr (assoc x
(anything-c-jabber-online-contacts)))))))))
2948 ;; (anything 'anything-c-source-jabber-contacts)
2952 (defvar anything-source-select-buffer
"*anything source select*")
2953 (defvar anything-c-source-call-source
2954 `((name .
"Call anything source")
2955 (candidate-number-limit .
9999)
2956 (candidates .
(lambda ()
2957 (loop for vname in
(all-completions "anything-c-source-" obarray
)
2958 for var
= (intern vname
)
2959 for name
= (ignore-errors (assoc-default 'name
(symbol-value var
)))
2960 if name collect
(cons (format "%s (%s)" name vname
) var
))))
2961 (action .
(("Invoke anything with selected source" .
2963 (setq anything-candidate-number-limit
9999)
2964 (anything candidate nil nil nil nil
2965 anything-source-select-buffer
)))
2966 ("Describe variable" . describe-variable
)))
2967 (persistent-action . describe-variable
)))
2968 ;; (anything 'anything-c-source-call-source)
2970 (defun anything-call-source ()
2971 "Call anything source."
2973 (anything 'anything-c-source-call-source nil nil nil nil
2974 anything-source-select-buffer
))
2976 (defun anything-call-source-from-anything ()
2977 "Call anything source within `anything' session."
2979 (setq anything-input-idle-delay
0)
2980 (anything-set-sources '(anything-c-source-call-source)))
2983 (defvar anything-c-source-occur
2986 (setq anything-c-source-occur-current-buffer
2988 (candidates .
(lambda ()
2989 (setq anything-occur-buf
(get-buffer-create "*Anything Occur*"))
2990 (with-current-buffer anything-occur-buf
2992 (let ((count (occur-engine anything-pattern
2993 (list anything-c-source-occur-current-buffer
) anything-occur-buf
2994 list-matching-lines-default-context-lines nil
2995 list-matching-lines-buffer-name-face
2996 nil list-matching-lines-face
2997 (not (eq occur-excluded-properties t
)))))
2999 (let ((lines (split-string (buffer-string) "\n" t
)))
3001 (action .
(("Goto line" .
(lambda (candidate)
3002 (goto-line (string-to-number candidate
) anything-c-source-occur-current-buffer
)))))
3003 (requires-pattern .
1)
3005 ;; (anything 'anything-c-source-occur)
3007 ;; Do many actions for input
3008 (defvar anything-c-source-create
3012 (candidate-number-limit .
9999)
3013 (action-transformer . anything-create--actions
))
3014 "Do many create actions from `anything-pattern'.
3015 See also `anything-create--actions'.")
3016 ;; (anything 'anything-c-source-create)
3018 (defun anything-create-from-anything ()
3019 "Run `anything-create' from `anything' as a fallback."
3021 (anything-run-after-quit 'anything-create nil anything-pattern
))
3023 (defun anything-create (&optional string initial-input
)
3024 "Do many create actions from STRING.
3025 See also `anything-create--actions'."
3027 (setq string
(or string
(read-string "Create Anything: " initial-input
)))
3028 (anything '(((name .
"Anything Create")
3029 (header-name .
(lambda (_) (format "Action for \"%s\"" string
)))
3030 (candidates . anything-create--actions
)
3031 (candidate-number-limit .
9999)
3032 (action .
(lambda (func) (funcall func string
)))))))
3034 (defun anything-create--actions (&rest ignored
)
3035 "Default actions for `anything-create' / `anything-c-source-create'."
3037 (lambda (pair) (and (consp pair
) (functionp (cdr pair
))))
3038 (append anything-create--actions-private
3039 '(("find-file" . find-file
)
3040 ("find-file other window" . find-file-other-window
)
3041 ("New buffer" . switch-to-buffer
)
3042 ("New buffer other window" . switch-to-buffer-other-window
)
3043 ("Bookmark Set" . bookmark-set
)
3045 (lambda (x) (set-register (read-char "Register: ") x
)))
3046 ("Insert Linkd star" . linkd-insert-star
)
3047 ("Insert Linkd Tag" . linkd-insert-tag
)
3048 ("Insert Linkd Link" . linkd-insert-link
)
3049 ("Insert Linkd Lisp" . linkd-insert-lisp
)
3050 ("Insert Linkd Wiki" . linkd-insert-wiki
)
3051 ("Google Search" . google
)))))
3053 ;; Minibuffer History
3054 (defvar anything-c-source-minibuffer-history
3055 '((name .
"Minibuffer History")
3056 (header-name .
(lambda (name) (format "%s (%s)" name minibuffer-history-variable
)))
3057 (candidates .
(lambda () (let ((history (symbol-value minibuffer-history-variable
)))
3058 (if (consp (car history
))
3059 (mapcar 'prin1-to-string history
)
3063 ;; (anything 'anything-c-source-minibuffer-history)
3066 (defvar anything-c-source-elscreen
3067 '((name .
"Elscreen")
3068 (candidates .
(lambda ()
3069 (if (cdr (elscreen-get-screen-to-name-alist))
3071 (loop for sname in
(elscreen-get-screen-to-name-alist)
3072 append
(list (format "[%d] %s" (car sname
) (cdr sname
))) into lst
3073 finally
(return lst
))
3074 '(lambda (a b
) (compare-strings a nil nil b nil nil
))))))
3075 (action .
(("Change Screen".
3077 (elscreen-goto (- (aref candidate
1) (aref "0" 0)))))
3080 (elscreen-kill (- (aref candidate
1) (aref "0" 0)))))
3083 (elscreen-goto (- (aref candidate
1) (aref "0" 0)))
3084 (elscreen-kill-others)))))))
3085 ;; (anything 'anything-c-source-elscreen)
3089 ;;; X RandR resolution change
3090 ;;; FIXME I do not care multi-display.
3091 (defvar anything-c-xrandr-output
"VGA")
3092 (defvar anything-c-xrandr-screen
"0")
3093 (defvar anything-c-source-xrandr-change-resolution
3094 '((name .
"Change Resolution")
3098 (call-process "xrandr" nil
(current-buffer) nil
3099 "--screen" anything-c-xrandr-screen
"-q")
3101 (loop while
(re-search-forward " \\([0-9]+x[0-9]+\\)" nil t
)
3102 collect
(match-string 1)))))
3104 ("Change Resolution" .
(lambda (mode)
3105 (call-process "xrandr" nil nil nil
3106 "--screen" anything-c-xrandr-screen
3107 "--output" anything-c-xrandr-output
3109 ;; (anything 'anything-c-source-xrandr-change-resolution)
3112 (defun anything-c-persistent-xfont-action (elm)
3113 "Show current font temporarily"
3114 (let ((default-font elm
))
3115 (set-default-font default-font
)))
3117 (defvar anything-c-xfonts-cache nil
)
3118 (defvar anything-c-source-xfonts
3119 '((name .
"X Fonts")
3121 (unless anything-c-xfonts-cache
3122 (setq anything-c-xfonts-cache
3123 (x-list-fonts "*")))))
3124 (candidates . anything-c-xfonts-cache
)
3127 (action .
(("Copy to kill ring" .
(lambda (elm)
3129 ("Set Font" .
(lambda (elm)
3131 (set-default-font elm
'keep-size
)
3132 (message "New font have been copied to kill ring")))))
3133 (persistent-action . anything-c-persistent-xfont-action
)))
3135 ;; (anything 'anything-c-source-xfonts)
3137 ;; Sources for gentoo users
3139 (defvar anything-gentoo-prefered-shell
'eshell
3140 "Your favorite shell to run emerge command.")
3142 (defvar anything-c-gentoo-use-flags nil
)
3143 (defvar anything-c-gentoo-buffer
"*anything-gentoo-output*")
3144 (defvar anything-c-cache-gentoo nil
)
3145 (defvar anything-c-cache-world nil
)
3146 (defvar anything-c-source-gentoo
3147 '((name .
"Portage sources")
3149 (get-buffer-create anything-c-gentoo-buffer
)
3150 (unless anything-c-cache-gentoo
3151 (anything-c-gentoo-setup-cache))
3152 (unless anything-c-cache-world
3153 (setq anything-c-cache-world
(anything-c-gentoo-get-world)))
3154 (anything-c-gentoo-init-list)))
3155 (candidates-in-buffer)
3157 (candidate-transformer anything-c-highlight-world
)
3158 (action .
(("Show package" .
(lambda (elm)
3159 (anything-c-gentoo-eshell-action elm
"eix")))
3160 ("Show history" .
(lambda (elm)
3161 (if (member elm anything-c-cache-world
)
3162 (anything-c-gentoo-eshell-action elm
"genlop -qe")
3163 (message "No infos on packages not yet installed"))))
3164 ("Copy in kill-ring" . kill-new
)
3165 ("insert at point" . insert
)
3166 ("Browse HomePage" .
(lambda (elm)
3167 (browse-url (car (anything-c-gentoo-get-url elm
)))))
3168 ("Show extra infos" .
(lambda (elm)
3169 (if (member elm anything-c-cache-world
)
3170 (anything-c-gentoo-eshell-action elm
"genlop -qi")
3171 (message "No infos on packages not yet installed"))))
3172 ("Show use flags" .
(lambda (elm)
3173 (anything-c-gentoo-default-action elm
"equery" "-C" "u")
3174 (font-lock-add-keywords nil
'(("^\+.*" . font-lock-variable-name-face
)))
3175 (font-lock-mode 1)))
3176 ("Run emerge pretend" .
(lambda (elm)
3177 (anything-c-gentoo-eshell-action elm
"emerge -p")))
3178 ("Emerge" . anything-gentoo-install
)
3179 ("Unmerge" . anything-gentoo-uninstall
)
3180 ("Show dependencies" .
(lambda (elm)
3181 (anything-c-gentoo-default-action elm
"equery" "-C" "d")))
3182 ("Show related files" .
(lambda (elm)
3183 (anything-c-gentoo-default-action elm
"equery" "files")))
3184 ("Update" .
(lambda (elm)
3185 (anything-c-gentoo-setup-cache)
3186 (setq anything-c-cache-world
(anything-c-gentoo-get-world))))))))
3188 ;; (anything 'anything-c-source-gentoo)
3190 (defun anything-gentoo-install (candidate)
3191 (funcall anything-gentoo-prefered-shell
)
3192 (if anything-c-marked-candidate-list
3193 (let ((elms (mapconcat 'identity anything-c-marked-candidate-list
" ")))
3194 (insert (concat "sudo emerge -av " elms
)))
3195 (insert (concat "sudo emerge -av " candidate
))))
3197 (defun anything-gentoo-uninstall (candidate)
3198 (funcall anything-gentoo-prefered-shell
)
3199 (if anything-c-marked-candidate-list
3200 (let ((elms (mapconcat 'identity anything-c-marked-candidate-list
" ")))
3201 (insert (concat "sudo emerge -avC " elms
)))
3202 (insert (concat "sudo emerge -avC " candidate
))))
3204 (defun anything-c-gentoo-default-action (elm command
&rest args
)
3205 "Gentoo default action that use `anything-c-gentoo-buffer'."
3206 (if (member elm anything-c-cache-world
)
3208 (switch-to-buffer anything-c-gentoo-buffer
)
3210 (let ((com-list (append args
(list elm
))))
3211 (apply #'call-process command nil t nil
3213 (message "No infos on packages not yet installed")))
3215 (defvar anything-c-source-use-flags
3216 '((name .
"Use Flags")
3218 (unless anything-c-gentoo-use-flags
3219 (anything-c-gentoo-setup-use-flags-cache))
3220 (anything-c-gentoo-get-use)))
3221 (candidates-in-buffer)
3223 (candidate-transformer anything-c-highlight-local-use
)
3224 (action .
(("Show which dep use this flag"
3226 (switch-to-buffer anything-c-gentoo-buffer
)
3228 (apply #'call-process
"equery" nil t nil
3234 (switch-to-buffer anything-c-gentoo-buffer
)
3236 (apply #'call-process
"euse" nil t nil
3239 (font-lock-add-keywords nil
`((,elm . font-lock-variable-name-face
)))
3240 (font-lock-mode 1)))))))
3243 ;; (anything 'anything-c-source-use-flags)
3245 (defun anything-c-gentoo-init-list ()
3246 "Initialize buffer with all packages in Portage."
3247 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
3248 (buf (anything-candidate-buffer 'portage-buf
)))
3249 (with-current-buffer buf
3250 (dolist (i anything-c-cache-gentoo
)
3251 (insert (concat i
"\n"))))))
3253 (defun anything-c-gentoo-setup-cache ()
3254 "Set up `anything-c-cache-gentoo'"
3255 (setq anything-c-cache-gentoo
3256 (split-string (with-temp-buffer
3257 (call-process "eix" nil t nil
3261 (defun anything-c-gentoo-eshell-action (elm command
)
3262 (when (get-buffer "*EShell Command Output*")
3263 (kill-buffer "*EShell Command Output*"))
3264 (message "Wait searching...")
3265 (eshell-command (format "%s %s" command elm
)))
3267 (defun anything-c-gentoo-get-use ()
3268 "Initialize buffer with all use flags."
3269 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
3270 (buf (anything-candidate-buffer 'use-buf
)))
3271 (with-current-buffer buf
3272 (dolist (i anything-c-gentoo-use-flags
)
3273 (insert (concat i
"\n"))))))
3276 (defun anything-c-gentoo-setup-use-flags-cache ()
3277 "Setup `anything-c-gentoo-use-flags'"
3278 (setq anything-c-gentoo-use-flags
3279 (split-string (with-temp-buffer
3280 (call-process "eix" nil t nil
3281 "--print-all-useflags")
3284 (defun anything-c-gentoo-get-url (elm)
3285 "Return a list of urls from eix output."
3286 (split-string (eshell-command-result
3287 (format "eix %s | grep Homepage | awk '{print $2}'" elm
))))
3289 (defun anything-c-gentoo-get-world ()
3290 "Return list of all installed package on your system."
3291 (split-string (with-temp-buffer
3292 (call-process "qlist" nil t nil
3296 (defun anything-c-gentoo-get-local-use ()
3297 (split-string (with-temp-buffer
3298 (call-process "portageq" nil t nil
3303 (defface anything-gentoo-match-face
'((t (:foreground
"red")))
3304 "Face for anything-gentoo installed packages."
3305 :group
'traverse-faces
)
3307 (defun anything-c-highlight-world (eix)
3308 "Highlight all installed package."
3310 if
(member i anything-c-cache-world
)
3311 collect
(propertize i
'face
'anything-gentoo-match-face
)
3315 (defun anything-c-highlight-local-use (use-flags)
3316 (let ((local-uses (anything-c-gentoo-get-local-use)))
3317 (loop for i in use-flags
3318 if
(member i local-uses
)
3319 collect
(propertize i
'face
'anything-gentoo-match-face
)
3323 (defvar anything-c-source-emacs-process
3324 '((name .
"Emacs Process")
3325 (candidates .
(lambda ()
3326 (mapcar #'process-name
3328 (action .
(("Kill Process" .
(lambda (elm)
3329 (delete-process (get-process elm
))))))))
3331 ;; (anything 'anything-c-source-emacs-process)
3334 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3336 (defvar anything-c-external-commands-list nil
3337 "A list of all external commands the user can execute. If this
3338 variable is not set by the user, it will be calculated
3341 (defun anything-c-external-commands-list-1 ()
3342 "Returns a list of all external commands the user can execute.
3344 If `anything-c-external-commands-list' is non-nil it will
3345 return its contents. Else it calculates all external commands
3346 and sets `anything-c-external-commands-list'.
3348 The code is ripped out of `eshell-complete-commands-list'."
3349 (if anything-c-external-commands-list
3350 anything-c-external-commands-list
3351 (setq anything-c-external-commands-list
3352 (let* ((paths (split-string (getenv "PATH") path-separator
))
3353 (cwd (file-name-as-directory
3354 (expand-file-name default-directory
)))
3355 (path "") (comps-in-path ())
3356 (file "") (filepath "") (completions ()))
3357 ;; Go thru each path in the search path, finding completions.
3359 (setq path
(file-name-as-directory
3360 (expand-file-name (or (car paths
) ".")))
3362 (and (file-accessible-directory-p path
)
3363 (file-name-all-completions "" path
)))
3364 ;; Go thru each completion found, to see whether it should be
3365 ;; used, e.g. see if it's executable.
3366 (while comps-in-path
3367 (setq file
(car comps-in-path
)
3368 filepath
(concat path file
))
3369 (if (and (not (member file completions
))
3370 (or (string-equal path cwd
)
3371 (not (file-directory-p filepath
)))
3372 (file-executable-p filepath
))
3373 (setq completions
(cons file completions
)))
3374 (setq comps-in-path
(cdr comps-in-path
)))
3375 (setq paths
(cdr paths
)))
3378 (defun anything-c-file-buffers (filename)
3379 "Returns a list of those buffer names which correspond to the
3380 file given by FILENAME."
3382 (dolist (buf (buffer-list) ret
)
3383 (let ((bfn (buffer-file-name buf
)))
3385 (string= filename bfn
))
3386 (push (buffer-name buf
) ret
)))
3389 (defun anything-c-delete-file (file)
3390 "Delete the given file after querying the user. Ask to kill
3391 buffers associated with that file, too."
3392 (if (y-or-n-p (format "Really delete file %s? " file
))
3394 (let ((buffers (anything-c-file-buffers file
)))
3396 (dolist (buf buffers
)
3397 (when (y-or-n-p (format "Kill buffer %s, too? " buf
))
3398 (kill-buffer buf
)))))
3399 (message "Nothing deleted.")))
3401 (defun anything-c-open-file-externally (file)
3402 "Open FILE with an external tool. Query the user which tool to
3404 (start-process "anything-c-open-file-externally"
3406 (completing-read "Program: "
3407 (anything-c-external-commands-list-1))
3410 (defun w32-shell-execute-open-file (file)
3411 (interactive "fOpen file:")
3413 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
3415 (replace-regexp-in-string ; strip cygdrive paths
3416 "/cygdrive/\\(.\\)" "\\1:" file nil nil
) nil t
))))
3417 (defun anything-c-open-file-with-default-tool (file)
3418 "Open FILE with the default tool on this platform."
3419 (if (eq system-type
'windows-nt
)
3420 (w32-shell-execute-open-file file
)
3421 (start-process "anything-c-open-file-with-default-tool"
3423 (cond ((eq system-type
'gnu
/linux
)
3425 ((or (eq system-type
'darwin
) ;; Mac OS X
3426 (eq system-type
'macos
)) ;; Mac OS 9
3430 (defun anything-c-open-dired (file)
3431 "Opens a dired buffer in FILE's directory. If FILE is a
3432 directory, open this directory."
3433 (if (file-directory-p file
)
3435 (dired (file-name-directory file
))
3436 (dired-goto-file file
)))
3438 (defun anything-c-display-to-real-line (candidate)
3439 (if (string-match "^ *\\([0-9]+\\):\\(.+\\)$" candidate
)
3440 (list (string-to-number (match-string 1 candidate
)) (match-string 2 candidate
))
3441 (error "Line number not found")))
3443 (defun anything-c-action-line-goto (lineno-and-content)
3444 (apply #'anything-goto-file-line
(anything-attr 'target-file
)
3445 (append lineno-and-content
3446 (list (if (and (anything-attr-defined 'target-file
)
3447 (not anything-in-persistent-action
))
3448 'find-file-other-window
3451 (defun* anything-c-action-file-line-goto
(file-line-content &optional
(find-file-function #'find-file
))
3452 (apply #'anything-goto-file-line file-line-content
))
3455 (defun anything-c-filtered-candidate-transformer-file-line (candidates source
)
3458 (if (not (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.+\\)$" candidate
))
3459 (error "Filename and line number not found")
3460 (let ((filename (match-string 1 candidate
))
3461 (lineno (match-string 2 candidate
))
3462 (content (match-string 3 candidate
)))
3463 (cons (format "%s:%s\n %s"
3464 (propertize filename
'face compilation-info-face
)
3465 (propertize lineno
'face compilation-line-face
)
3467 (list (expand-file-name
3469 (anything-aif (anything-attr 'default-directory
)
3470 (if (functionp it
) (funcall it
) it
)
3471 (and (anything-candidate-buffer)
3474 (anything-candidate-buffer)))))
3475 (string-to-number lineno
) content
)))))
3478 (defun* anything-goto-file-line
(file lineno content
&optional
(find-file-function #'find-file
))
3479 (anything-aif (anything-attr 'before-jump-hook
)
3481 (when file
(funcall find-file-function file
))
3482 (if (anything-attr-defined 'adjust
)
3483 (anything-c-goto-line-with-adjustment lineno content
)
3485 (unless (anything-attr-defined 'recenter
)
3486 (set-window-start (get-buffer-window anything-current-buffer
) (point)))
3487 (anything-aif (anything-attr 'after-jump-hook
)
3489 (when anything-in-persistent-action
3490 (anything-match-line-color-current-line)))
3492 (defun anything-find-file-as-root (candidate)
3493 (find-file (concat "/" anything-su-or-sudo
"::" (expand-file-name candidate
))))
3495 ;; borrowed from etags.el
3496 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
3497 (defun anything-c-goto-line-with-adjustment (line line-content
)
3500 ;; This constant is 1/2 the initial search window.
3501 ;; There is no sense in making it too small,
3502 ;; since just going around the loop once probably
3503 ;; costs about as much as searching 2000 chars.
3506 pat
(concat (if (eq selective-display t
)
3507 "\\(^\\|\^m\\) *" "^ *") ;allow indent
3508 (regexp-quote line-content
)))
3509 ;; If no char pos was given, try the given line number.
3510 (setq startpos
(progn (goto-line line
) (point)))
3511 (or startpos
(setq startpos
(point-min)))
3512 ;; First see if the tag is right at the specified location.
3513 (goto-char startpos
)
3514 (setq found
(looking-at pat
))
3515 (while (and (not found
)
3517 (goto-char (- startpos offset
))
3520 (re-search-forward pat
(+ startpos offset
) t
)
3521 offset
(* 3 offset
))) ; expand search window
3523 (re-search-forward pat nil t
)
3524 (error "not found")))
3525 ;; Position point at the right place
3526 ;; if the search string matched an extra Ctrl-m at the beginning.
3527 (and (eq selective-display t
)
3530 (beginning-of-line))
3532 (anything-document-attribute 'default-directory
"type . file-line"
3533 "`default-directory' to interpret file.")
3534 (anything-document-attribute 'before-jump-hook
"type . file-line / line"
3535 "Function to call before jumping to the target location.")
3536 (anything-document-attribute 'after-jump-hook
"type . file-line / line"
3537 "Function to call after jumping to the target location.")
3538 (anything-document-attribute 'adjust
"type . file-line"
3539 "Search around line matching line contents.")
3540 (anything-document-attribute 'recenter
"type . file-line / line"
3541 "`recenter' after jumping.")
3542 (anything-document-attribute 'target-file
"type . line"
3543 "Goto line of target-file.")
3545 (defun anything-c-call-interactively (cmd-or-name)
3546 "Execute CMD-OR-NAME as Emacs command.
3547 It is added to `extended-command-history'.
3548 `anything-current-prefix-arg' is used as the command's prefix argument."
3549 (setq extended-command-history
3550 (cons (anything-c-stringify cmd-or-name
)
3551 (delete (anything-c-stringify cmd-or-name
) extended-command-history
)))
3552 (let ((current-prefix-arg anything-current-prefix-arg
))
3553 (call-interactively (anything-c-symbolify cmd-or-name
))))
3555 (defun anything-c-set-variable (var)
3556 "Set value to VAR interactively."
3558 (let ((sym (anything-c-symbolify var
)))
3559 (set sym
(eval-minibuffer (format "Set %s: " var
)
3560 (prin1-to-string (symbol-value sym
))))))
3562 ;; (anything-c-set-variable 'hh)
3564 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Persistent Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3565 (defvar anything-match-line-overlay-face nil
)
3566 (defvar anything-match-line-overlay nil
)
3568 (defun anything-match-line-color-current-line (&optional start end buf face rec
)
3569 "Highlight and underline current position"
3570 (let ((args (list (or start
(line-beginning-position))
3571 (or end
(1+ (line-end-position)))
3573 (if (not anything-match-line-overlay
)
3574 (setq anything-match-line-overlay
(apply 'make-overlay args
))
3575 (apply 'move-overlay anything-match-line-overlay args
)))
3576 (overlay-put anything-match-line-overlay
3577 'face
(or face anything-match-line-overlay-face
))
3582 (defalias 'anything-persistent-highlight-point
'anything-match-line-color-current-line
)
3584 (defface anything-overlay-line-face
'((t (:background
"IndianRed4" :underline t
)))
3585 "Face for source header in the anything buffer." :group
'anything
)
3587 (setq anything-match-line-overlay-face
'anything-overlay-line-face
)
3589 (add-hook 'anything-cleanup-hook
#'(lambda ()
3590 (when anything-match-line-overlay
3591 (delete-overlay anything-match-line-overlay
)
3592 (setq anything-match-line-overlay nil
))))
3594 (add-hook 'anything-after-persistent-action-hook
#'(lambda ()
3595 (when anything-match-line-overlay
3596 (delete-overlay anything-match-line-overlay
)
3597 (anything-match-line-color-current-line))))
3599 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3601 (defun anything-c-transform-file-load-el (actions candidate
)
3602 "Add action to load the file CANDIDATE if it is an emacs lisp
3603 file. Else return ACTIONS unmodified."
3604 (if (or (string= (file-name-extension candidate
) "el")
3605 (string= (file-name-extension candidate
) "elc"))
3606 (append actions
'(("Load Emacs Lisp File" . load-file
)))
3609 (defun anything-c-transform-file-browse-url (actions candidate
)
3610 "Add an action to browse the file CANDIDATE if it in a html
3611 file or URL. Else return ACTIONS unmodified."
3612 (if (string-match "^http\\|^ftp\\|html?$" candidate
)
3613 (cons '("Browse with Browser" . browse-url
) actions
)
3617 (defun anything-c-transform-function-call-interactively (actions candidate
)
3618 "Add an action to call the function CANDIDATE interactively if
3619 it is a command. Else return ACTIONS unmodified."
3620 (if (commandp (intern-soft candidate
))
3621 (append actions
'(("Call Interactively"
3623 anything-c-call-interactively
)))
3627 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate
)
3628 "If CANDIDATE's `car' is a command, then add an action to
3629 evaluate it and put it onto the `command-history'."
3630 (if (commandp (car (read candidate
)))
3631 ;; Make it first entry
3632 (cons '("Eval and put onto command-history" .
3634 (let ((sym (read sexp
)))
3636 (setq command-history
3637 (cons sym command-history
)))))
3641 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Candidate Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3643 (defun anything-c-skip-boring-buffers (buffers)
3644 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp
))
3646 (defun anything-c-skip-current-buffer (buffers)
3647 (if anything-allow-skipping-current-buffer
3648 (remove (buffer-name anything-current-buffer
) buffers
)
3651 (defun anything-c-shadow-boring-buffers (buffers)
3652 "Buffers matching `anything-c-boring-buffer-regexp' will be
3653 displayed with the `file-name-shadow' face if available."
3654 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp
))
3657 (defun anything-c-shadow-boring-files (files)
3658 "Files matching `anything-c-boring-file-regexp' will be
3659 displayed with the `file-name-shadow' face if available."
3660 (anything-c-shadow-entries files anything-c-boring-file-regexp
))
3662 (defun anything-c-skip-boring-files (files)
3663 "Files matching `anything-c-boring-file-regexp' will be skipped."
3664 (anything-c-skip-entries files anything-c-boring-file-regexp
))
3665 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
3667 (defun anything-c-skip-current-file (files)
3668 "Current file will be skipped."
3669 (remove (buffer-file-name anything-current-buffer
) files
))
3671 (defun anything-c-w32-pathname-transformer (args)
3672 "Change undesirable features of windows pathnames to ones more acceptable to
3673 other candidate transformers."
3674 (if (eq system-type
'windows-nt
)
3676 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x
))
3678 (replace-regexp-in-string "\\\\" "/" y
)) args
))
3681 (defun anything-c-shorten-home-path (files)
3682 "Replaces /home/user with ~."
3683 (mapcar (lambda (file)
3684 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
3686 (if (and (stringp file
) (string-match home file
))
3687 (cons (replace-match "~" nil nil file
) file
)
3692 (defun anything-c-mark-interactive-functions (functions)
3693 "Mark interactive functions (commands) with (i) after the function name."
3695 (loop for function in functions
3696 do
(push (cons (concat function
3697 (when (commandp (intern-soft function
)) " (i)"))
3700 finally
(return (nreverse list
)))))
3702 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adaptive Sorting of Candidates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3703 (defvar anything-c-adaptive-done nil
3704 "nil if history information is not yet stored for the current
3707 (defvar anything-c-adaptive-history nil
3708 "Contains the stored history information.
3709 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
3711 (defadvice anything-initialize
(before anything-c-adaptive-initialize activate
)
3712 "Advise `anything-initialize' to reset `anything-c-adaptive-done'
3713 when anything is started."
3714 (setq anything-c-adaptive-done nil
))
3716 (defadvice anything-exit-minibuffer
(before anything-c-adaptive-exit-minibuffer activate
)
3717 "Advise `anything-exit-minibuffer' to store history information
3718 when a candidate is selected with RET."
3719 (anything-c-adaptive-store-selection))
3721 (defadvice anything-select-action
(before anything-c-adaptive-select-action activate
)
3722 "Advise `anything-select-action' to store history information
3723 when the user goes to the action list with TAB."
3724 (anything-c-adaptive-store-selection))
3726 (defun anything-c-adaptive-store-selection ()
3727 "Store history information for the selected candidate."
3728 (unless anything-c-adaptive-done
3729 (setq anything-c-adaptive-done t
)
3730 (let* ((source (anything-get-current-source))
3731 (source-name (or (assoc-default 'type source
)
3732 (assoc-default 'name source
)))
3733 (source-info (or (assoc source-name anything-c-adaptive-history
)
3735 (push (list source-name
) anything-c-adaptive-history
)
3736 (car anything-c-adaptive-history
))))
3737 (selection (anything-get-selection))
3738 (selection-info (progn
3741 (let ((found (assoc selection
(cdr source-info
))))
3746 ;; move entry to the beginning of the
3747 ;; list, so that it doesn't get
3748 ;; trimmed when the history is
3751 (delete found
(cdr source-info
)))
3754 (cadr source-info
)))
3755 (pattern-info (progn
3756 (setcdr selection-info
3758 (let ((found (assoc anything-pattern
(cdr selection-info
))))
3761 (cons anything-pattern
0)
3763 ;; move entry to the beginning of the
3764 ;; list, so if two patterns used the
3765 ;; same number of times then the one
3766 ;; used last appears first in the list
3767 (setcdr selection-info
3768 (delete found
(cdr selection-info
)))
3770 (cdr selection-info
)))
3771 (cadr selection-info
))))
3773 ;; increase usage count
3774 (setcdr pattern-info
(1+ (cdr pattern-info
)))
3776 ;; truncate history if needed
3777 (if (> (length (cdr selection-info
)) anything-c-adaptive-history-length
)
3778 (setcdr selection-info
3779 (subseq (cdr selection-info
) 0 anything-c-adaptive-history-length
))))))
3781 (if (file-readable-p anything-c-adaptive-history-file
)
3782 (load-file anything-c-adaptive-history-file
))
3783 (add-hook 'kill-emacs-hook
'anything-c-adaptive-save-history
)
3785 (defun anything-c-adaptive-save-history ()
3786 "Save history information to file given by `anything-c-adaptive-history-file'."
3790 ";; -*- mode: emacs-lisp -*-\n"
3791 ";; History entries used for anything adaptive display.\n")
3792 (prin1 `(setq anything-c-adaptive-history
',anything-c-adaptive-history
)
3795 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
3796 (unless (interactive-p) 'quiet
))))
3798 (defun anything-c-adaptive-sort (candidates source
)
3799 "Sort the CANDIDATES for SOURCE by usage frequency.
3800 This is a filtered candidate transformer you can use for the
3801 attribute `filtered-candidate-transformer' of a source in
3802 `anything-sources' or a type in `anything-type-attributes'."
3803 (let* ((source-name (or (assoc-default 'type source
)
3804 (assoc-default 'name source
)))
3805 (source-info (assoc source-name anything-c-adaptive-history
)))
3806 (if (not source-info
)
3807 ;; if there is no information stored for this source then do nothing
3811 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
3813 (mapcar (lambda (candidate-info)
3815 (dolist (pattern-info (cdr candidate-info
))
3816 (if (not (equal (car pattern-info
)
3818 (incf count
(cdr pattern-info
))
3820 ;; if current pattern is equal to the previously
3821 ;; used one then this candidate has priority
3822 ;; (that's why its count is boosted by 10000) and
3823 ;; it only has to compete with other candidates
3824 ;; which were also selected with the same pattern
3825 (setq count
(+ 10000 (cdr pattern-info
)))
3827 (cons (car candidate-info
) count
)))
3831 ;; sort the list in descending order, so candidates with highest
3832 ;; priorty come first
3833 (setq usage
(sort usage
(lambda (first second
)
3834 (> (cdr first
) (cdr second
)))))
3836 ;; put those candidates first which have the highest usage count
3837 (dolist (info usage
)
3838 (when (member* (car info
) candidates
3839 :test
'anything-c-adaptive-compare
)
3840 (push (car info
) sorted
)
3841 (setq candidates
(remove* (car info
) candidates
3842 :test
'anything-c-adaptive-compare
))))
3844 ;; and append the rest
3845 (append (reverse sorted
) candidates nil
)))))
3847 (defun anything-c-adaptive-compare (x y
)
3848 "Compare candidates X and Y taking into account that the
3849 candidate can be in (DISPLAY . REAL) format."
3850 (equal (if (listp x
)
3857 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Plug-in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3858 ;; Plug-in: candidates-file
3859 (defun anything-compile-source--candidates-file (source)
3860 (if (assoc-default 'candidates-file source
)
3861 `((init anything-p-candidats-file-init
3862 ,@(let ((orig-init (assoc-default 'init source
)))
3863 (cond ((null orig-init
) nil
)
3864 ((functionp orig-init
) (list orig-init
))
3866 (candidates-in-buffer)
3869 (add-to-list 'anything-compile-source-functions
'anything-compile-source--candidates-file
)
3871 (defun anything-p-candidats-file-init ()
3872 (destructuring-bind (file &optional updating
)
3873 (anything-mklist (anything-attr 'candidates-file
))
3874 (when (symbolp file
)
3875 (setq file
(symbol-value file
)))
3876 (with-current-buffer (anything-candidate-buffer (find-file-noselect file
))
3878 (buffer-disable-undo)
3880 (auto-revert-mode 1)))))
3882 (anything-document-attribute 'candidates-file
"candidates-file plugin"
3883 "Use a file as the candidates buffer.
3885 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
3887 ;; Plug-in: headline
3888 (defun anything-compile-source--anything-headline (source)
3889 (if (assoc-default 'headline source
)
3890 (append '((init . anything-headline-init
)
3891 (get-line-fn . buffer-substring
)
3894 '((candidates-in-buffer)))
3896 (add-to-list 'anything-compile-source-functions
'anything-compile-source--anything-headline
)
3898 (defun anything-headline-init ()
3899 (when (and (anything-current-buffer-is-modified)
3900 (with-current-buffer anything-current-buffer
3901 (eval (or (anything-attr 'condition
) t
))))
3902 (anything-headline-make-candidate-buffer
3903 (anything-attr 'headline
)
3904 (anything-attr 'subexp
))))
3906 (anything-document-attribute 'headline
"Headline plug-in"
3907 "Regexp string for anything-headline to scan.")
3908 (anything-document-attribute 'condition
"Headline plug-in"
3909 "A sexp representing the condition to use anything-headline.")
3910 (anything-document-attribute 'subexp
"Headline plug-in"
3911 "Display (match-string-no-properties subexp).")
3913 (defun anything-headline-get-candidates (regexp subexp
)
3915 (set-buffer anything-current-buffer
)
3917 (goto-char (point-min))
3918 (if (functionp regexp
) (setq regexp
(funcall regexp
)))
3919 (let (hierarchy curhead
)
3921 (if (numberp subexp
)
3922 (cons (match-string-no-properties subexp
) (match-beginning subexp
))
3923 (cons (buffer-substring (point-at-bol) (point-at-eol))
3925 (hierarchies (headlines)
3926 (1+ (loop for
(_ . hierarchy
) in headlines
3927 maximize hierarchy
)))
3929 (loop for i from
0 to hierarchy
3930 collecting
(aref curhead i
)))
3931 (arrange (headlines)
3932 (loop with curhead
= (make-vector (hierarchies headlines
) "")
3933 for
((str . pt
) . hierarchy
) in headlines
3934 do
(aset curhead hierarchy str
)
3937 (mapconcat 'identity
(vector-0-n curhead hierarchy
) " / ")
3942 (loop for re in regexp
3943 for hierarchy from
0
3944 do
(goto-char (point-min))
3947 while
(re-search-forward re nil t
)
3948 collect
(cons (matched) hierarchy
)))
3949 (lambda (a b
) (> (cdar b
) (cdar a
)))))
3950 (loop while
(re-search-forward regexp nil t
)
3951 collect
(matched))))))))
3953 (defun anything-headline-make-candidate-buffer (regexp subexp
)
3954 (with-current-buffer (anything-candidate-buffer 'local
)
3955 (loop for
(content . pos
) in
(anything-headline-get-candidates regexp subexp
)
3958 (with-current-buffer anything-current-buffer
3959 (line-number-at-pos pos
))
3962 (defun anything-headline-goto-position (pos recenter
)
3965 (set-window-start (get-buffer-window anything-current-buffer
) (point))))
3967 (defun anything-revert-buffer (candidate)
3968 (with-current-buffer candidate
3969 (when (buffer-modified-p)
3970 (revert-buffer t t
))))
3972 (defun anything-revert-marked-buffers (candidate)
3973 (dolist (i anything-c-marked-candidate-list
)
3974 (anything-revert-buffer i
)))
3976 (defun anything-kill-marked-buffers (candidate)
3977 (dolist (i anything-c-marked-candidate-list
)
3980 (defun anything-delete-marked-files (candidate)
3981 (dolist (i anything-c-marked-candidate-list
)
3982 (anything-c-delete-file i
)))
3984 (defun anything-ediff-marked-buffers (candidate &optional merge
)
3985 "Ediff 2 marked buffers or 1 marked buffer and current-buffer.
3986 With optional arg `merge' call `ediff-merge-buffers'."
3987 (let ((lg-lst (length anything-c-marked-candidate-list
))
3991 (error "Error:You have to mark at least 1 buffer"))
3993 (setq buf1 anything-current-buffer
3994 buf2
(first anything-c-marked-candidate-list
)))
3996 (setq buf1
(first anything-c-marked-candidate-list
)
3997 buf2
(second anything-c-marked-candidate-list
)))
3999 (error "Error:To much buffers marked!")))
4001 (ediff-merge-buffers buf1 buf2
)
4002 (ediff-buffers buf1 buf2
))))
4004 (defun anything-bookmark-get-bookmark-from-name (bmk)
4005 "Return bookmark name even if it is a bookmark with annotation.
4006 e.g prepended with *.
4007 Return nil if bmk is not a valid bookmark."
4008 (let ((bookmark (replace-regexp-in-string "\*" "" bmk
)))
4009 (if (assoc bookmark bookmark-alist
)
4011 (when (assoc bmk bookmark-alist
)
4014 (defun anything-delete-marked-bookmarks (elm)
4015 "Delete this bookmark or all marked bookmarks."
4016 (let ((bookmark (anything-bookmark-get-bookmark-from-name elm
)))
4017 (anything-aif anything-c-marked-candidate-list
4019 (let ((bmk (anything-bookmark-get-bookmark-from-name i
)))
4020 (bookmark-delete bmk
'batch
)))
4021 (bookmark-delete bookmark
'batch
))))
4023 (defun anything-bookmark-active-region-maybe (candidate)
4024 "Active saved region if this bookmark have one."
4025 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4027 (when (and (boundp bookmarkp-use-region-flag
)
4028 bookmarkp-use-region-flag
)
4029 (let ((bmk-name (or (bookmarkp-get-buffer-name bookmark
)
4030 (file-name-nondirectory
4031 (bookmark-get-filename bookmark
)))))
4033 (with-current-buffer bmk-name
4034 (setq deactivate-mark nil
)))))
4038 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Setup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4041 (define-anything-type-attribute 'buffer
4044 '(("Switch to buffer other window" . switch-to-buffer-other-window
)
4045 ("Switch to buffer" . switch-to-buffer
))
4046 '(("Switch to buffer" . switch-to-buffer
)
4047 ("Switch to buffer other window" . switch-to-buffer-other-window
)
4048 ("Switch to buffer other frame" . switch-to-buffer-other-frame
)))
4049 ("Display buffer" . display-buffer
)
4050 ("Revert buffer" . anything-revert-buffer
)
4051 ("Revert Marked buffers" . anything-revert-marked-buffers
)
4052 ("Kill buffer" . kill-buffer
)
4053 ("Kill Marked buffers" . anything-kill-marked-buffers
)
4054 ("Ediff Marked buffers" . anything-ediff-marked-buffers
)
4055 ("Ediff Merge marked buffers" .
(lambda (candidate)
4056 (anything-ediff-marked-buffers candidate t
))))
4057 (candidate-transformer anything-c-skip-current-buffer anything-c-skip-boring-buffers
))
4058 "Buffer or buffer name.")
4060 (define-anything-type-attribute 'file
4063 '(("Find file other window" . find-file-other-window
)
4064 ("Find file" . find-file
)
4065 ("Find file as root" . anything-find-file-as-root
))
4066 '(("Find file" . find-file
)
4067 ("Find file as root" . anything-find-file-as-root
)
4068 ("Find file other window" . find-file-other-window
)
4069 ("Find file other frame" . find-file-other-frame
)))
4070 ("Open dired in file's directory" . anything-c-open-dired
)
4071 ("Delete file" . anything-c-delete-file
)
4072 ("Delete Marked files" . anything-delete-marked-files
)
4073 ("Open file externally" . anything-c-open-file-externally
)
4074 ("Open file with default tool" . anything-c-open-file-with-default-tool
))
4075 (action-transformer anything-c-transform-file-load-el
4076 anything-c-transform-file-browse-url
)
4077 (candidate-transformer anything-c-w32-pathname-transformer
4078 anything-c-skip-current-file
4079 anything-c-skip-boring-files
4080 anything-c-shorten-home-path
))
4083 (define-anything-type-attribute 'command
4084 `((action ("Call interactively" . anything-c-call-interactively
)
4085 ("Describe command" . anything-c-describe-function
)
4086 ("Add command to kill ring" . anything-c-kill-new
)
4087 ("Go to command's definition" . anything-c-find-function
))
4088 ;; Sort commands according to their usage count.
4089 (filtered-candidate-transformer . anything-c-adaptive-sort
))
4090 "Command. (string or symbol)")
4092 (define-anything-type-attribute 'function
4093 '((action ("Describe function" . anything-c-describe-function
)
4094 ("Add function to kill ring" . anything-c-kill-new
)
4095 ("Go to function's definition" . anything-c-find-function
))
4096 (action-transformer anything-c-transform-function-call-interactively
)
4097 (candidate-transformer anything-c-mark-interactive-functions
))
4098 "Function. (string or symbol)")
4100 (define-anything-type-attribute 'variable
4101 '((action ("Describe variable" . anything-c-describe-variable
)
4102 ("Add variable to kill ring" . anything-c-kill-new
)
4103 ("Go to variable's definition" . anything-c-find-variable
)
4104 ("Set variable" . anything-c-set-variable
)))
4107 (define-anything-type-attribute 'sexp
4108 '((action ("Eval s-expression" .
(lambda (c) (eval (read c
))))
4109 ("Add s-expression to kill ring" . kill-new
))
4110 (action-transformer anything-c-transform-sexp-eval-command-sexp
))
4111 "String representing S-Expressions.")
4113 (define-anything-type-attribute 'bookmark
4115 ("Jump to bookmark" .
(lambda (candidate)
4116 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4117 (bookmark-jump bookmark
))
4119 (anything-bookmark-active-region-maybe candidate
)))
4120 ("Jump to BM other window" .
(lambda (candidate)
4121 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4122 (bookmark-jump-other-window bookmark
))
4124 (anything-bookmark-active-region-maybe candidate
)))
4125 ("Bookmark edit annotation" .
(lambda (candidate)
4126 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4127 (bookmark-edit-annotation bookmark
))))
4128 ("Bookmark show annotation" .
(lambda (candidate)
4129 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4130 (bookmark-show-annotation bookmark
))))
4131 ("Delete bookmark(s)" . anything-delete-marked-bookmarks
)
4132 ,@(when (fboundp 'bookmarkp-edit-bookmark
)
4133 '(("Edit Bookmark" .
(lambda (candidate)
4134 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4135 (bookmarkp-edit-bookmark bookmark
))))))
4136 ("Rename bookmark" .
(lambda (candidate)
4137 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4138 (bookmark-rename bookmark
))))
4139 ("Relocate bookmark" .
(lambda (candidate)
4140 (let ((bookmark (anything-bookmark-get-bookmark-from-name candidate
)))
4141 (bookmark-relocate bookmark
))))
4144 (define-anything-type-attribute 'line
4145 '((display-to-real . anything-c-display-to-real-line
)
4146 (action ("Go to Line" . anything-c-action-line-goto
)))
4147 "LINENO:CONTENT string, eg. \" 16:foo\".")
4150 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
4151 ;; (install-elisp "http://www.emacswiki.org/cgi-bin/wiki/download/el-mock.el")
4153 (when (fboundp 'expectations
)
4155 (desc "candidates-file plug-in")
4156 (expect '(anything-p-candidats-file-init)
4157 (assoc-default 'init
4158 (car (anything-compile-sources
4160 (candidates-file .
"test.txt")))
4161 '(anything-compile-source--candidates-file)))))
4162 (expect '(anything-p-candidats-file-init
4164 (assoc-default 'init
4165 (car (anything-compile-sources
4167 (candidates-file .
"test.txt")
4168 (init .
(lambda () 1))))
4169 '(anything-compile-source--candidates-file)))))
4170 (expect '(anything-p-candidats-file-init
4172 (assoc-default 'init
4173 (car (anything-compile-sources
4175 (candidates-file .
"test.txt")
4176 (init (lambda () 1))))
4177 '(anything-compile-source--candidates-file)))))
4178 (desc "anything-c-source-buffers")
4179 (expect '(("Buffers" ("foo" "curbuf")))
4180 (stub buffer-list
=> '("curbuf" " hidden" "foo" "*anything*"))
4181 (let ((anything-c-boring-buffer-regexp
4186 " *Echo Area" " *Minibuf"))))
4187 (flet ((buffer-name (x) x
))
4188 (anything-test-candidates 'anything-c-source-buffers
))))
4189 (desc "anything-c-stringify")
4191 (anything-c-stringify "str1"))
4193 (anything-c-stringify 'str2
))
4194 (desc "anything-c-symbolify")
4196 (anything-c-symbolify "sym1"))
4198 (anything-c-symbolify 'sym2
)))))
4201 (provide 'anything-config
)
4203 ;;; Local Variables:
4204 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
4207 ;; How to save (DO NOT REMOVE!!)
4208 ;; (emacswiki-post "anything-config.el")
4209 ;;; anything-config.el ends here
4211 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
4212 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
4213 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
4214 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
4215 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
4216 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
4217 ;;; LocalWords: dotimes Thierry online vname
4218 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
4219 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
4220 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
4221 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
4222 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
4223 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
4224 ;;; LocalWords: startpos noselect dont desc
