anything-config.el (anything-show-this-source-only): revived
[anything-config.git] / anything-config.el
blobae76e6bf4eedb6e197af5de1237c9c84fa96b43f
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 ~ 2011, Tassilo Horn, all rights reserved.
11 ;; Copyright (C) 2009, Andy Stewart, all rights reserved.
12 ;; Copyright (C) 2009 ~ 2011, rubikitch, all rights reserved.
13 ;; Copyright (C) 2009 ~ 2011, Thierry Volpiatto, all rights reserved.
14 ;; Created: 2009-02-16 21:38:23
15 ;; Version: 0.4.1
16 ;; X-URL: http://repo.or.cz/w/anything-config.git
17 ;; Keywords: anything, anything-config
18 ;; Compatibility: GNU Emacs 22 ~ 24
20 ;; Features that might be required by this library:
22 ;; `anything'
25 ;;; This file is NOT part of GNU Emacs
27 ;;; License
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)
32 ;; any later version.
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.
44 ;;; !NOTICE!
46 ;; If this file does not work, upgrade anything.el!
47 ;; http://www.emacswiki.org/cgi-bin/wiki/download/anything.el
49 ;;; Commentary:
51 ;; Predefined configurations for `anything.el'
53 ;; For quick start, try `anything-for-files' to open files.
55 ;; To configure anything you should define anything command
56 ;; with your favorite sources, like below:
58 ;; (defun my-anything ()
59 ;; (interactive)
60 ;; (anything-other-buffer
61 ;; '(anything-c-source-buffers
62 ;; anything-c-source-file-name-history
63 ;; anything-c-source-info-pages
64 ;; anything-c-source-info-elisp
65 ;; anything-c-source-man-pages
66 ;; anything-c-source-locate
67 ;; anything-c-source-emacs-commands)
68 ;; " *my-anything*"))
70 ;; Then type M-x my-anything to use sources.
72 ;; Defining own command is better than setup `anything-sources'
73 ;; directly, because you can define multiple anything commands with
74 ;; different sources. Each anything command should have own anything
75 ;; buffer, because M-x anything-resume revives anything command.
77 ;;; Autodoc documentation:
78 ;; ---------------------
80 ;; * Commands defined here are:
81 ;; [EVAL] (autodoc-document-lisp-buffer :type 'command :prefix "anything-" :docstring t)
82 ;; `anything-configuration'
83 ;; Customize `anything'.
84 ;; `anything-mini'
85 ;; Preconfigured `anything' lightweight version (buffer -> recentf).
86 ;; `anything-for-files'
87 ;; Preconfigured `anything' for opening files.
88 ;; `anything-recentf'
89 ;; Preconfigured `anything' for `recentf'.
90 ;; `anything-info-at-point'
91 ;; Preconfigured `anything' for searching info at point.
92 ;; `anything-info-emacs'
93 ;; Preconfigured anything for Emacs manual index.
94 ;; `anything-show-kill-ring'
95 ;; Preconfigured `anything' for `kill-ring'.
96 ;; `anything-minibuffer-history'
97 ;; Preconfigured `anything' for `minibuffer-history'.
98 ;; `anything-gentoo'
99 ;; Preconfigured `anything' for gentoo linux.
100 ;; `anything-imenu'
101 ;; Preconfigured `anything' for `imenu'.
102 ;; `anything-google-suggest'
103 ;; Preconfigured `anything' for google search with google suggest.
104 ;; `anything-yahoo-suggest'
105 ;; Preconfigured `anything' for Yahoo searching with Yahoo suggest.
106 ;; `anything-for-buffers'
107 ;; Preconfigured `anything' for buffer.
108 ;; `anything-buffers-list'
109 ;; Enhanced preconfigured `anything' for buffer.
110 ;; `anything-bbdb'
111 ;; Preconfigured `anything' for BBDB.
112 ;; `anything-locate'
113 ;; Preconfigured `anything' for Locate.
114 ;; `anything-w3m-bookmarks'
115 ;; Preconfigured `anything' for w3m bookmark.
116 ;; `anything-firefox-bookmarks'
117 ;; Preconfigured `anything' for firefox bookmark.
118 ;; `anything-colors'
119 ;; Preconfigured `anything' for color.
120 ;; `anything-bookmarks'
121 ;; Preconfigured `anything' for bookmarks.
122 ;; `anything-c-pp-bookmarks'
123 ;; Preconfigured `anything' for bookmarks (pretty-printed).
124 ;; `anything-c-insert-latex-math'
125 ;; Preconfigured anything for latex math symbols completion.
126 ;; `anything-register'
127 ;; Preconfigured `anything' for Emacs registers.
128 ;; `anything-man-woman'
129 ;; Preconfigured `anything' for Man and Woman pages.
130 ;; `anything-org-keywords'
131 ;; Preconfigured `anything' for org keywords.
132 ;; `anything-emms'
133 ;; Preconfigured `anything' for emms sources.
134 ;; `anything-eev-anchors'
135 ;; Preconfigured `anything' for eev anchors.
136 ;; `anything-bm-list'
137 ;; Preconfigured `anything' for visible bookmarks.
138 ;; `anything-timers'
139 ;; Preconfigured `anything' for timers.
140 ;; `anything-list-emacs-process'
141 ;; Preconfigured `anything' for emacs process.
142 ;; `anything-occur'
143 ;; Preconfigured Anything for Occur source.
144 ;; `anything-browse-code'
145 ;; Preconfigured anything to browse code.
146 ;; `anything-org-headlines'
147 ;; Preconfigured anything to show org headlines.
148 ;; `anything-info-gnus'
149 ;; Preconfigured anything to browse Gnus Manual.
150 ;; `anything-regexp'
151 ;; Preconfigured anything to build regexps and run query-replace-regexp against.
152 ;; `anything-test-sources'
153 ;; List all anything sources for test.
154 ;; `anything-select-source'
155 ;; Select source.
156 ;; `anything-mark-all'
157 ;; Mark all visible unmarked candidates in current source.
158 ;; `anything-unmark-all'
159 ;; Unmark all candidates in all sources of current anything session.
160 ;; `anything-toggle-all-marks'
161 ;; Toggle all marks.
162 ;; `anything-c-buffer-help'
163 ;; Help command for anything buffers.
164 ;; `anything-buffer-diff-persistent'
165 ;; Toggle diff buffer without quitting anything.
166 ;; `anything-buffer-revert-persistent'
167 ;; Revert buffer without quitting anything.
168 ;; `anything-buffer-save-persistent'
169 ;; Save buffer without quitting anything.
170 ;; `anything-buffer-run-kill-buffers'
171 ;; Run kill buffer action from `anything-c-source-buffers-list'.
172 ;; `anything-buffer-run-grep'
173 ;; Run Grep action from `anything-c-source-buffers-list'.
174 ;; `anything-buffer-run-zgrep'
175 ;; Run Grep action from `anything-c-source-buffers-list'.
176 ;; `anything-buffer-run-query-replace-regexp'
177 ;; Run Query replace regexp action from `anything-c-source-buffers-list'.
178 ;; `anything-buffer-run-query-replace'
179 ;; Run Query replace action from `anything-c-source-buffers-list'.
180 ;; `anything-buffer-switch-other-window'
181 ;; Run switch to other window action from `anything-c-source-buffers-list'.
182 ;; `anything-buffer-switch-other-frame'
183 ;; Run switch to other frame action from `anything-c-source-buffers-list'.
184 ;; `anything-buffer-switch-to-elscreen'
185 ;; Run switch to elscreen action from `anything-c-source-buffers-list'.
186 ;; `anything-c-copy-files-async'
187 ;; Preconfigured anything to copy file list FLIST to DEST asynchronously.
188 ;; `anything-ff-help'
189 ;; Help command for `anything-find-files'.
190 ;; `anything-ff-run-toggle-auto-update'
191 ;; Not documented.
192 ;; `anything-ff-run-switch-to-history'
193 ;; Run Switch to history action from `anything-c-source-find-files'.
194 ;; `anything-ff-run-grep'
195 ;; Run Grep action from `anything-c-source-find-files'.
196 ;; `anything-ff-run-pdfgrep'
197 ;; Run Pdfgrep action from `anything-c-source-find-files'.
198 ;; `anything-ff-run-zgrep'
199 ;; Run Grep action from `anything-c-source-find-files'.
200 ;; `anything-ff-run-copy-file'
201 ;; Run Copy file action from `anything-c-source-find-files'.
202 ;; `anything-ff-run-rename-file'
203 ;; Run Rename file action from `anything-c-source-find-files'.
204 ;; `anything-ff-run-byte-compile-file'
205 ;; Run Byte compile file action from `anything-c-source-find-files'.
206 ;; `anything-ff-run-load-file'
207 ;; Run Load file action from `anything-c-source-find-files'.
208 ;; `anything-ff-run-eshell-command-on-file'
209 ;; Run eshell command on file action from `anything-c-source-find-files'.
210 ;; `anything-ff-run-ediff-file'
211 ;; Run Ediff file action from `anything-c-source-find-files'.
212 ;; `anything-ff-run-ediff-merge-file'
213 ;; Run Ediff merge file action from `anything-c-source-find-files'.
214 ;; `anything-ff-run-symlink-file'
215 ;; Run Symlink file action from `anything-c-source-find-files'.
216 ;; `anything-ff-run-delete-file'
217 ;; Run Delete file action from `anything-c-source-find-files'.
218 ;; `anything-ff-run-complete-fn-at-point'
219 ;; Run complete file name action from `anything-c-source-find-files'.
220 ;; `anything-ff-run-switch-to-eshell'
221 ;; Run switch to eshell action from `anything-c-source-find-files'.
222 ;; `anything-ff-run-switch-other-window'
223 ;; Run switch to other window action from `anything-c-source-find-files'.
224 ;; `anything-ff-run-switch-other-frame'
225 ;; Run switch to other frame action from `anything-c-source-find-files'.
226 ;; `anything-ff-run-open-file-externally'
227 ;; Run open file externally command action from `anything-c-source-find-files'.
228 ;; `anything-ff-run-gnus-attach-files'
229 ;; Run gnus attach files command action from `anything-c-source-find-files'.
230 ;; `anything-ff-run-etags'
231 ;; Run Etags command action from `anything-c-source-find-files'.
232 ;; `anything-ff-run-print-file'
233 ;; Run Print file action from `anything-c-source-find-files'.
234 ;; `anything-find-files-down-one-level'
235 ;; Go down one level like unix command `cd ..'.
236 ;; `anything-ff-properties-persistent'
237 ;; Show properties without quitting anything.
238 ;; `anything-ff-run-kill-buffer-persistent'
239 ;; Execute `anything-ff-kill-buffer-fname' whitout quitting.
240 ;; `anything-ff-rotate-left-persistent'
241 ;; Rotate image left without quitting anything.
242 ;; `anything-ff-rotate-right-persistent'
243 ;; Rotate image right without quitting anything.
244 ;; `anything-find-files'
245 ;; Preconfigured `anything' for anything implementation of `find-file'.
246 ;; `anything-write-file'
247 ;; Preconfigured `anything' providing completion for `write-file'.
248 ;; `anything-insert-file'
249 ;; Preconfigured `anything' providing completion for `insert-file'.
250 ;; `anything-dired-rename-file'
251 ;; Preconfigured `anything' to rename files from dired.
252 ;; `anything-dired-copy-file'
253 ;; Preconfigured `anything' to copy files from dired.
254 ;; `anything-dired-symlink-file'
255 ;; Preconfigured `anything' to symlink files from dired.
256 ;; `anything-dired-hardlink-file'
257 ;; Preconfigured `anything' to hardlink files from dired.
258 ;; `anything-generic-file-help'
259 ;; Not documented.
260 ;; `anything-do-grep'
261 ;; Preconfigured anything for grep.
262 ;; `anything-c-goto-precedent-file'
263 ;; Go to precedent file in anything grep/etags buffers.
264 ;; `anything-c-goto-next-file'
265 ;; Go to precedent file in anything grep/etags buffers.
266 ;; `anything-grep-help'
267 ;; Not documented.
268 ;; `anything-c-grep-run-persistent-action'
269 ;; Run grep persistent action from `anything-do-grep-1'.
270 ;; `anything-c-grep-run-default-action'
271 ;; Run grep default action from `anything-do-grep-1'.
272 ;; `anything-c-grep-run-other-window-action'
273 ;; Run grep goto other window action from `anything-do-grep-1'.
274 ;; `anything-c-grep-run-save-buffer'
275 ;; Run grep save results action from `anything-do-grep-1'.
276 ;; `anything-pdfgrep-help'
277 ;; Not documented.
278 ;; `anything-do-pdfgrep'
279 ;; Not documented.
280 ;; `anything-yank-text-at-point'
281 ;; Yank text at point in minibuffer.
282 ;; `anything-etags-help'
283 ;; The help function for etags.
284 ;; `anything-c-etags-select'
285 ;; Preconfigured anything for etags.
286 ;; `anything-filelist'
287 ;; Preconfigured `anything' to open files instantly.
288 ;; `anything-filelist+'
289 ;; Preconfigured `anything' to open files/buffers/bookmarks instantly.
290 ;; `anything-c-describe-attributes'
291 ;; Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
292 ;; `anything-M-x'
293 ;; Preconfigured `anything' for Emacs commands.
294 ;; `anything-manage-advice'
295 ;; Preconfigured `anything' to disable/enable function advices.
296 ;; `anything-bookmark-ext'
297 ;; Preconfigured `anything' for bookmark-extensions sources.
298 ;; `anything-simple-call-tree'
299 ;; Preconfigured `anything' for simple-call-tree. List function relationships.
300 ;; `anything-mark-ring'
301 ;; Preconfigured `anything' for `anything-c-source-mark-ring'.
302 ;; `anything-global-mark-ring'
303 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring'.
304 ;; `anything-all-mark-rings'
305 ;; Preconfigured `anything' for `anything-c-source-global-mark-ring' and `anything-c-source-mark-ring'.
306 ;; `anything-yaoddmuse-cache-pages'
307 ;; Fetch the list of files on emacswiki and create cache file.
308 ;; `anything-yaoddmuse-emacswiki-edit-or-view'
309 ;; Preconfigured `anything' to edit or view EmacsWiki page.
310 ;; `anything-yaoddmuse-emacswiki-post-library'
311 ;; Preconfigured `anything' to post library to EmacsWiki.
312 ;; `anything-eval-expression'
313 ;; Preconfigured anything for `anything-c-source-evaluation-result'.
314 ;; `anything-eval-new-line-and-indent'
315 ;; Not documented.
316 ;; `anything-eval-expression-with-eldoc'
317 ;; Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support.
318 ;; `anything-calcul-expression'
319 ;; Preconfigured anything for `anything-c-source-calculation-result'.
320 ;; `anything-surfraw'
321 ;; Preconfigured `anything' to search PATTERN with search ENGINE.
322 ;; `anything-call-source'
323 ;; Preconfigured `anything' to call anything source.
324 ;; `anything-call-source-from-anything'
325 ;; Call anything source within `anything' session.
326 ;; `anything-execute-anything-command'
327 ;; Preconfigured `anything' to execute preconfigured `anything'.
328 ;; `anything-create-from-anything'
329 ;; Run `anything-create' from `anything' as a fallback.
330 ;; `anything-create'
331 ;; Preconfigured `anything' to do many create actions from STRING.
332 ;; `anything-top'
333 ;; Preconfigured `anything' for top command.
334 ;; `anything-select-xfont'
335 ;; Preconfigured `anything' to select Xfont.
336 ;; `anything-world-time'
337 ;; Preconfigured `anything' to show world time.
338 ;; `anything-apt'
339 ;; Preconfigured `anything' : frontend of APT package manager.
340 ;; `anything-esh-pcomplete'
341 ;; Preconfigured anything to provide anything completion in eshell.
342 ;; `anything-eshell-history'
343 ;; Preconfigured anything for eshell history.
344 ;; `anything-lisp-completion-at-point'
345 ;; Anything lisp symbol completion at point.
346 ;; `anything-lisp-completion-at-point-or-indent'
347 ;; First call indent and second call complete lisp symbol.
348 ;; `anything-c-complete-file-name-at-point'
349 ;; Complete file name at point.
350 ;; `anything-c-run-external-command'
351 ;; Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
352 ;; `anything-ratpoison-commands'
353 ;; Preconfigured `anything' to execute ratpoison commands.
354 ;; `anything-c-set-variable'
355 ;; Set value to VAR interactively.
356 ;; `anything-c-adaptive-save-history'
357 ;; Save history information to file given by `anything-c-adaptive-history-file'.
358 ;; `anything-c-reset-adaptative-history'
359 ;; Delete all `anything-c-adaptive-history' and his file.
360 ;; `anything-c-toggle-match-plugin'
361 ;; Toggle anything-match-plugin.
363 ;; * User variables defined here:
364 ;; [EVAL] (autodoc-document-lisp-buffer :type 'user-variable :prefix "anything-" :var-value t)
365 ;; `anything-c-use-standard-keys'
366 ;; Default Value: nil
367 ;; `anything-c-adaptive-history-file'
368 ;; Default Value: "~/.emacs.d/anything-c-adaptive-history"
369 ;; `anything-c-adaptive-history-length'
370 ;; Default Value: 50
371 ;; `anything-c-google-suggest-url'
372 ;; Default Value: "http://google.com/complete/search?output=toolbar&q="
373 ;; `anything-c-google-suggest-search-url'
374 ;; Default Value: "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
375 ;; `anything-google-suggest-use-curl-p'
376 ;; Default Value: nil
377 ;; `anything-c-yahoo-suggest-url'
378 ;; Default Value: "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=G [...]
379 ;; `anything-c-yahoo-suggest-search-url'
380 ;; Default Value: "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
381 ;; `anything-c-boring-buffer-regexp'
382 ;; Default Value: "\\ (\\` \\)\\|\\*anything\\| \\*Echo Area\\| \\*Minibuf"
383 ;; `anything-c-boring-file-regexp'
384 ;; Default Value: "/\\ (?:\\(?:\\.\\(?:git\\|hg\\|svn\\)\\|CVS\\|_darcs\\)\\)\\(?:/\\|$\\)\\| [...]
385 ;; `anything-kill-ring-threshold'
386 ;; Default Value: 10
387 ;; `anything-su-or-sudo'
388 ;; Default Value: "su"
389 ;; `anything-for-files-prefered-list'
390 ;; Default Value: (anything-c-source-ffap-line anything-c-source-ffap-guesser anything-c-sou [...]
391 ;; `anything-create--actions-private'
392 ;; Default Value: nil
393 ;; `anything-allow-skipping-current-buffer'
394 ;; Default Value: t
395 ;; `anything-c-enable-eval-defun-hack'
396 ;; Default Value: t
397 ;; `anything-tramp-verbose'
398 ;; Default Value: 0
399 ;; `anything-raise-command'
400 ;; Default Value: nil
401 ;; `anything-command-map-prefix-key'
402 ;; Default Value: "<f5> a"
403 ;; `anything-c-find-files-show-icons'
404 ;; Default Value: nil
405 ;; `anything-c-find-files-icons-directory'
406 ;; Default Value: "/usr/local/share/emacs/24.0.50/etc/images/tree-widget/default"
407 ;; `anything-c-browse-code-regexp-lisp'
408 ;; Default Value: "^ * (def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|type\\|th [...]
409 ;; `anything-c-browse-code-regexp-python'
410 ;; Default Value: "\\<def\\>\\|\\<class\\>"
411 ;; `anything-c-browse-code-regexp-alist'
412 ;; Default Value: ((lisp-interaction-mode . "^ *(def\\(un\\|subst\\|macro\\|face\\|alias\\|a [...]
413 ;; `anything-c-external-programs-associations'
414 ;; Default Value: nil
415 ;; `anything-ff-auto-update-initial-value'
416 ;; Default Value: t
417 ;; `anything-c-copy-async-prefered-emacs'
418 ;; Default Value: "emacs"
419 ;; `anything-ff-lynx-style-map'
420 ;; Default Value: t
421 ;; `anything-ff-history-max-length'
422 ;; Default Value: 100
423 ;; `anything-ff-smart-completion'
424 ;; Default Value: t
425 ;; `anything-ff-default-kbsize'
426 ;; Default Value: 1024.0
427 ;; `anything-ff-tramp-not-fancy'
428 ;; Default Value: t
429 ;; `anything-ff-exif-data-program'
430 ;; Default Value: "exiftran"
431 ;; `anything-ff-exif-data-program-args'
432 ;; Default Value: "-d"
433 ;; `anything-c-grep-use-ioccur-style-keys'
434 ;; Default Value: t
435 ;; `anything-c-pdfgrep-default-read-command'
436 ;; Default Value: "xpdf '%f' %p"
437 ;; `anything-c-etags-tag-file-name'
438 ;; Default Value: "TAGS"
439 ;; `anything-c-etags-tag-file-search-limit'
440 ;; Default Value: 10
441 ;; `anything-c-filelist-file-name'
442 ;; Default Value: nil
443 ;; `anything-c-eldoc-in-minibuffer-show-fn'
444 ;; Default Value: anything-c-eldoc-show-in-mode-line
445 ;; `anything-c-turn-on-show-completion'
446 ;; Default Value: t
447 ;; `anything-lisp-completion-or-indent-delay'
448 ;; Default Value: 0.6
449 ;; `anything-c-default-external-file-browser'
450 ;; Default Value: "nautilus"
451 ;; `anything-c-use-adaptative-sorting'
452 ;; Default Value: nil
453 ;; `anything-ff-newfile-prompt-p'
454 ;; Default Value: t
456 ;; * Anything sources defined here:
457 ;; [EVAL] (autodoc-document-lisp-buffer :type 'anything-source :prefix "anything-" :any-sname t)
458 ;; `anything-c-source-regexp' (Regexp Builder)
459 ;; `anything-c-source-buffers' (Buffers)
460 ;; `anything-c-source-buffer-not-found' (Create buffer)
461 ;; `anything-c-source-buffers-list' (Buffers)
462 ;; `anything-c-source-file-name-history' (File Name History)
463 ;; `anything-c-source-files-in-current-dir' (Files from Current Directory)
464 ;; `anything-c-source-files-in-current-dir+' (Files from Current Directory)
465 ;; `anything-c-source-find-files' (Find Files (`C-.':Go to precedent level))
466 ;; `anything-c-source-write-file' (Write File (`C-.':Go to precedent level))
467 ;; `anything-c-source-insert-file' (Insert File (`C-.':Go to precedent level))
468 ;; `anything-c-source-copy-files' (Copy Files (`C-.':Go to precedent level))
469 ;; `anything-c-source-symlink-files' (Symlink Files (`C-.':Go to precedent level))
470 ;; `anything-c-source-hardlink-files' (Hardlink Files (`C-.':Go to precedent level))
471 ;; `anything-c-source-file-cache' (File Cache)
472 ;; `anything-c-source-locate' (Locate)
473 ;; `anything-c-source-etags-select' (Etags)
474 ;; `anything-c-source-recentf' (Recentf)
475 ;; `anything-c-source-ffap-guesser' (File at point)
476 ;; `anything-c-source-ffap-line' (File/Lineno at point)
477 ;; `anything-c-source-files-in-all-dired' (Files in all dired buffer.)
478 ;; `anything-c-source-filelist' (FileList)
479 ;; `anything-c-source-info-pages' (Info Pages)
480 ;; `anything-c-source-info-elisp' (Info index: elisp)
481 ;; `anything-c-source-info-cl' (Info index: cl)
482 ;; `anything-c-source-info-org' (Info index: org)
483 ;; `anything-c-source-info-ratpoison' (Info index: ratpoison)
484 ;; `anything-c-source-info-zsh' (Info index: zsh)
485 ;; `anything-c-source-info-bash' (Info index: bash)
486 ;; `anything-c-source-info-coreutils' (Info index: coreutils)
487 ;; `anything-c-source-info-fileutils' (Info index: fileutils)
488 ;; `anything-c-source-info-find' (Info index: find)
489 ;; `anything-c-source-info-sh-utils' (Info index: sh-utils)
490 ;; `anything-c-source-info-textutils' (Info index: textutils)
491 ;; `anything-c-source-info-libc' (Info index: libc)
492 ;; `anything-c-source-info-make' (Info index: make)
493 ;; `anything-c-source-info-automake' (Info index: automake)
494 ;; `anything-c-source-info-autoconf' (Info index: autoconf)
495 ;; `anything-c-source-info-emacs-lisp-intro' (Info index: emacs-lisp-intro)
496 ;; `anything-c-source-info-emacs' (Info index: emacs)
497 ;; `anything-c-source-info-elib' (Info index: elib)
498 ;; `anything-c-source-info-eieio' (Info index: eieio)
499 ;; `anything-c-source-info-gauche-refe' (Info index: gauche)
500 ;; `anything-c-source-info-guile' (Info index: guile)
501 ;; `anything-c-source-info-guile-tut' (Info index: guile-tut)
502 ;; `anything-c-source-info-goops' (Info index: goops)
503 ;; `anything-c-source-info-screen' (Info index: screen)
504 ;; `anything-c-source-info-latex' (Info index: latex)
505 ;; `anything-c-source-info-gawk' (Info index: gawk)
506 ;; `anything-c-source-info-sed' (Info index: sed)
507 ;; `anything-c-source-info-m4' (Info index: m4)
508 ;; `anything-c-source-info-wget' (Info index: wget)
509 ;; `anything-c-source-info-binutils' (Info index: binutils)
510 ;; `anything-c-source-info-as' (Info index: as)
511 ;; `anything-c-source-info-bfd' (Info index: bfd)
512 ;; `anything-c-source-info-gprof' (Info index: gprof)
513 ;; `anything-c-source-info-ld' (Info index: ld)
514 ;; `anything-c-source-info-diff' (Info index: diff)
515 ;; `anything-c-source-info-flex' (Info index: flex)
516 ;; `anything-c-source-info-grep' (Info index: grep)
517 ;; `anything-c-source-info-gzip' (Info index: gzip)
518 ;; `anything-c-source-info-libtool' (Info index: libtool)
519 ;; `anything-c-source-info-texinfo' (Info index: texinfo)
520 ;; `anything-c-source-info-info' (Info index: info)
521 ;; `anything-c-source-info-gdb' (Info index: gdb)
522 ;; `anything-c-source-info-stabs' (Info index: stabs)
523 ;; `anything-c-source-info-cvsbook' (Info index: cvsbook)
524 ;; `anything-c-source-info-cvs' (Info index: cvs)
525 ;; `anything-c-source-info-bison' (Info index: bison)
526 ;; `anything-c-source-info-id-utils' (Info index: id-utils)
527 ;; `anything-c-source-info-global' (Info index: global)
528 ;; `anything-c-source-man-pages' (Manual Pages)
529 ;; `anything-c-source-complex-command-history' (Complex Command History)
530 ;; `anything-c-source-extended-command-history' (Emacs Commands History)
531 ;; `anything-c-source-emacs-commands' (Emacs Commands)
532 ;; `anything-c-source-lacarte' (Lacarte)
533 ;; `anything-c-source-emacs-functions' (Emacs Functions)
534 ;; `anything-c-source-emacs-functions-with-abbrevs' (Emacs Functions)
535 ;; `anything-c-source-advice' (Function Advice)
536 ;; `anything-c-source-emacs-variables' (Emacs Variables)
537 ;; `anything-c-source-bookmarks' (Bookmarks)
538 ;; `anything-c-source-bookmark-set' (Set Bookmark)
539 ;; `anything-c-source-bm' (Visible Bookmarks)
540 ;; `anything-c-source-bookmarks-ssh' (Bookmarks-ssh)
541 ;; `anything-c-source-bookmarks-su' (Bookmarks-root)
542 ;; `anything-c-source-bookmarks-local' (Bookmarks-Local)
543 ;; `anything-c-source-bmkext-addressbook' (Bookmark Addressbook)
544 ;; `anything-c-source-bookmark-w3m' (Bookmark W3m)
545 ;; `anything-c-source-bookmark-images' (Bookmark Images)
546 ;; `anything-c-source-bookmark-man' (Bookmark Woman&Man)
547 ;; `anything-c-source-bookmark-gnus' (Bookmark Gnus)
548 ;; `anything-c-source-bookmark-info' (Bookmark Info)
549 ;; `anything-c-source-bookmark-files&dirs' (Bookmark Files&Directories)
550 ;; `anything-c-source-bookmark-su-files&dirs' (Bookmark Root-Files&Directories)
551 ;; `anything-c-source-bookmark-ssh-files&dirs' (Bookmark Ssh-Files&Directories)
552 ;; `anything-c-source-firefox-bookmarks' (Firefox Bookmarks)
553 ;; `anything-c-source-w3m-bookmarks' (W3m Bookmarks)
554 ;; `anything-c-source-elisp-library-scan' (Elisp libraries (Scan))
555 ;; `anything-c-source-imenu' (Imenu)
556 ;; `anything-c-source-ctags' (Exuberant ctags)
557 ;; `anything-c-source-semantic' (Semantic Tags)
558 ;; `anything-c-source-simple-call-tree-functions-callers' (Function is called by)
559 ;; `anything-c-source-simple-call-tree-callers-functions' (Function calls)
560 ;; `anything-c-source-commands-and-options-in-file' (Commands/Options in file)
561 ;; `anything-c-source-customize-face' (Customize Face)
562 ;; `anything-c-source-colors' (Colors)
563 ;; `anything-c-source-tracker-search' (Tracker Search)
564 ;; `anything-c-source-mac-spotlight' (mdfind)
565 ;; `anything-c-source-kill-ring' (Kill Ring)
566 ;; `anything-c-source-mark-ring' (mark-ring)
567 ;; `anything-c-source-global-mark-ring' (global-mark-ring)
568 ;; `anything-c-source-register' (Registers)
569 ;; `anything-c-source-latex-math' (Latex Math Menu)
570 ;; `anything-c-source-fixme' (TODO/FIXME/DRY comments)
571 ;; `anything-c-source-rd-headline' (RD HeadLine)
572 ;; `anything-c-source-oddmuse-headline' (Oddmuse HeadLine)
573 ;; `anything-c-source-emacs-source-defun' (Emacs Source DEFUN)
574 ;; `anything-c-source-emacs-lisp-expectations' (Emacs Lisp Expectations)
575 ;; `anything-c-source-emacs-lisp-toplevels' (Emacs Lisp Toplevel / Level 4 Comment / Linkd Star)
576 ;; `anything-c-source-org-headline' (Org HeadLine)
577 ;; `anything-c-source-yaoddmuse-emacswiki-edit-or-view' (Yaoddmuse Edit or View (EmacsWiki))
578 ;; `anything-c-source-yaoddmuse-emacswiki-post-library' (Yaoddmuse Post library (EmacsWiki))
579 ;; `anything-c-source-eev-anchor' (Anchors)
580 ;; `anything-c-source-org-keywords' (Org Keywords)
581 ;; `anything-c-source-picklist' (Picklist)
582 ;; `anything-c-source-bbdb' (BBDB)
583 ;; `anything-c-source-evaluation-result' (Evaluation Result)
584 ;; `anything-c-source-calculation-result' (Calculation Result)
585 ;; `anything-c-source-google-suggest' (Google Suggest)
586 ;; `anything-c-source-yahoo-suggest' (Yahoo Suggest)
587 ;; `anything-c-source-emms-streams' (Emms Streams)
588 ;; `anything-c-source-emms-dired' (Music Directory)
589 ;; `anything-c-source-emms-files' (Emms files)
590 ;; `anything-c-source-jabber-contacts' (Jabber Contacts)
591 ;; `anything-c-source-call-source' (Call anything source)
592 ;; `anything-c-source-anything-commands' (Preconfigured Anything)
593 ;; `anything-c-source-occur' (Occur)
594 ;; `anything-c-source-browse-code' (Browse code)
595 ;; `anything-c-source-create' (Create)
596 ;; `anything-c-source-minibuffer-history' (Minibuffer History)
597 ;; `anything-c-source-elscreen' (Elscreen)
598 ;; `anything-c-source-top' (Top (Press C-c C-u to refresh))
599 ;; `anything-c-source-absolute-time-timers' (Absolute Time Timers)
600 ;; `anything-c-source-idle-time-timers' (Idle Time Timers)
601 ;; `anything-c-source-xrandr-change-resolution' (Change Resolution)
602 ;; `anything-c-source-xfonts' (X Fonts)
603 ;; `anything-c-source-time-world' (Time World List)
604 ;; `anything-c-source-apt' (APT)
605 ;; `anything-c-source-gentoo' (Portage sources)
606 ;; `anything-c-source-use-flags' (Use Flags)
607 ;; `anything-c-source-emacs-process' (Emacs Process)
608 ;; `anything-c-source-esh' (Eshell completions)
609 ;; `anything-c-source-eshell-history' (Eshell history)
610 ;; `anything-c-source-ratpoison-commands' (Ratpoison Commands)
612 ;; *** END auto-documentation
615 ;;; Change log:
617 ;; Change log of this file is found at
618 ;; http://repo.or.cz/w/anything-config.git/history/master:/anything-config.el
620 ;; Change log of this project is found at
621 ;; http://repo.or.cz/w/anything-config.git?a=shortlog
623 ;;; Contributors:
625 ;; Tamas Patrovics
626 ;; Tassilo Horn <tassilo@member.fsf.org>
627 ;; Vagn Johansen <gonz808@hotmail.com>
628 ;; Mathias Dahl <mathias.dahl@gmail.com>
629 ;; Bill Clementson <billclem@gmail.com>
630 ;; Stefan Kamphausen (see http://www.skamphausen.de for more informations)
631 ;; Drew Adams <drew.adams@oracle.com>
632 ;; Jason McBrayer <jmcbray@carcosa.net>
633 ;; Andy Stewart <lazycat.manatee@gmail.com>
634 ;; Thierry Volpiatto <thierry.volpiatto@gmail.com>
635 ;; rubikitch <rubikitch@ruby-lang.org>
636 ;; Scott Vokes <vokes.s@gmail.com>
637 ;; Kenichirou Oyama <k1lowxb@gmail.com>
639 ;;; For Maintainers:
641 ;; Evaluate (autodoc-update-all) before commit. This function
642 ;; generates anything-c-source-* / functions / options list.
644 ;; Install also developer-tools/autodoc.el
645 ;; And eval it or run interactively.
647 ;; [EVAL IT] (autodoc-update-all)
649 ;; Please write details documentation about function, then others will
650 ;; read code more easier. -- Andy Stewart
654 ;;; TODO
656 ;; - Fix documentation, now many functions haven't documentations.
659 ;;; Code:
662 ;;; Require
665 (require 'anything)
666 (require 'thingatpt)
667 (require 'ffap)
668 (require 'cl)
669 (require 'dired-aux)
670 (require 'dired-x)
671 (require 'tramp)
672 (require 'grep)
673 (require 'url)
674 (require 'xml)
675 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
676 (eval-when-compile (require 'semantic nil t))
677 (require 'anything-match-plugin)
681 ;;; Declare external functions
684 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
685 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
686 (declare-function image-dired-update-property "image-dired.el" (prop value))
687 (declare-function woman-file-name-all-completions "woman.el" (topic))
688 (declare-function Man-getpage-in-background "man.el" (topic))
689 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
690 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
691 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
692 (declare-function org-get-current-options "ext:org-exp.el")
693 (declare-function emms-streams "ext:emms-streams")
694 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
695 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
696 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
697 (declare-function emms-stream-quit "ext:emms-streams")
698 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
699 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
700 (declare-function emms-playlist-first "ext:emms")
701 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
702 (declare-function term-line-mode "term")
703 (declare-function term-char-mode "term")
704 (declare-function term-send-input "term")
705 (declare-function term-send-eof "term")
706 (declare-function Info-index-nodes "info" (&optional file))
707 (declare-function Info-goto-node "info" (&optional fork))
708 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
709 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
710 (declare-function elscreen-goto "ext:elscreen.el" (screen))
711 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
712 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
713 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
714 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
715 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
716 (declare-function bbdb "ext:bbdb-com")
717 (declare-function bbdb-current-record "ext:bbdb-com")
718 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
719 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
720 (declare-function bbdb-current-record "ext:bbdb-com")
721 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
722 (declare-function bbdb-records "ext:bbdb-com"
723 (&optional dont-check-disk already-in-db-buffer))
724 (declare-function eshell-read-aliases-list "em-alias")
725 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
726 (declare-function eldoc-current-symbol "eldoc")
727 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
728 (declare-function eldoc-get-var-docstring "eldoc" (sym))
729 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
730 (declare-function find-library-name "find-func.el" (library))
731 (declare-function adoc-construct "ext:auto-document.el" (buf))
732 (declare-function adoc-first-line "ext:auto-document.el" (str))
733 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
737 ;;; compatibility
740 (unless (fboundp 'window-system)
741 (defun window-system (&optional arg)
742 window-system))
746 ;;; Customize
749 (defgroup anything-config nil
750 "Predefined configurations for `anything.el'."
751 :group 'anything)
753 (defcustom anything-c-adaptive-history-file
754 "~/.emacs.d/anything-c-adaptive-history"
755 "Path of file where history information is stored."
756 :type 'string
757 :group 'anything-config)
759 (defcustom anything-c-adaptive-history-length 50
760 "Maximum number of candidates stored for a source."
761 :type 'number
762 :group 'anything-config)
764 (defcustom anything-c-google-suggest-url
765 "http://google.com/complete/search?output=toolbar&q="
766 "URL used for looking up Google suggestions."
767 :type 'string
768 :group 'anything-config)
770 (defcustom anything-c-google-suggest-search-url
771 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
772 "URL used for Google searching."
773 :type 'string
774 :group 'anything-config)
776 (defcustom anything-google-suggest-use-curl-p nil
777 "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
778 Otherwise `url-retrieve-synchronously' is used."
779 :type 'boolean
780 :group 'anything-config)
782 (defcustom anything-c-yahoo-suggest-url
783 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
784 "Url used for looking up Yahoo suggestions."
785 :type 'string
786 :group 'anything-config)
788 (defcustom anything-c-yahoo-suggest-search-url
789 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
790 "Url used for Yahoo searching."
791 :type 'string
792 :group 'anything-config)
794 (defcustom anything-c-boring-buffer-regexp
795 (rx (or
796 (group bos " ")
797 ;; anything-buffer
798 "*anything"
799 ;; echo area
800 " *Echo Area" " *Minibuf"))
801 "The regexp that match boring buffers.
802 Buffer candidates matching this regular expression will be
803 filtered from the list of candidates if the
804 `anything-c-skip-boring-buffers' candidate transformer is used, or
805 they will be displayed with face `file-name-shadow' if
806 `anything-c-shadow-boring-buffers' is used."
807 :type 'string
808 :group 'anything-config)
809 ;; (string-match anything-c-boring-buffer-regexp "buf")
810 ;; (string-match anything-c-boring-buffer-regexp " hidden")
811 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
813 (defcustom anything-c-boring-file-regexp
814 (rx (or
815 ;; Boring directories
816 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
817 ;; Boring files
818 (and line-start ".#")
819 (and (or ".class" ".la" ".o" "~") eol)))
820 "The regexp that match boring files.
821 File candidates matching this regular expression will be
822 filtered from the list of candidates if the
823 `anything-c-skip-boring-files' candidate transformer is used, or
824 they will be displayed with face `file-name-shadow' if
825 `anything-c-shadow-boring-files' is used."
826 :type 'string
827 :group 'anything-config)
829 (defcustom anything-kill-ring-threshold 10
830 "*Minimum length to be listed by `anything-c-source-kill-ring'."
831 :type 'integer
832 :group 'anything-config)
834 (defcustom anything-c-kill-ring-max-lines-number nil
835 "Max number of lines displayed per candidate in kill-ring browser.
836 If nil or zero, don't truncate candidate, show all."
837 :type 'integer
838 :group 'anything-config)
840 (defcustom anything-su-or-sudo "su"
841 "What command to use for root access."
842 :type 'string
843 :group 'anything-config)
845 (defcustom anything-for-files-prefered-list
846 '(anything-c-source-ffap-line
847 anything-c-source-ffap-guesser
848 anything-c-source-buffers-list
849 anything-c-source-recentf
850 anything-c-source-bookmarks
851 anything-c-source-file-cache
852 anything-c-source-files-in-current-dir+
853 anything-c-source-locate)
854 "Your prefered sources to find files."
855 :type 'list
856 :group 'anything-config)
858 (defcustom anything-create--actions-private nil
859 "User defined actions for `anything-create' / `anything-c-source-create'.
860 It is a list of (DISPLAY . FUNCTION) pairs like `action'
861 attribute of `anything-sources'.
863 It is prepended to predefined pairs."
864 :type 'list
865 :group 'anything-config)
867 (defcustom anything-allow-skipping-current-buffer t
868 "Show current buffer or not in anything buffer"
869 :type 'boolean
870 :group 'anything-config)
872 (defcustom anything-c-enable-eval-defun-hack t
873 "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
874 This hack is invoked when pressing C-M-x in the form \
875 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
876 :type 'boolean
877 :group 'anything-config)
879 (defcustom anything-tramp-verbose 0
880 "*Just like `tramp-verbose' but specific to anything.
881 When set to 0 don't show tramp messages in anything.
882 If you want to have the default tramp messages set it to 3."
883 :type 'integer
884 :group 'anything-config)
886 (defcustom anything-raise-command nil
887 "*A shell command to jump to a window running specific program.
888 Need external program wmctrl.
889 This will be use with `format', so use something like \"wmctrl -xa %s\"."
890 :type 'string
891 :group 'anything-config)
893 (defun anything-set-anything-command-map-prefix-key (var key)
894 (declare (special anything-command-map-prefix-key))
895 (when (boundp 'anything-command-map-prefix-key)
896 (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
897 (setq anything-command-map-prefix-key key)
898 (global-set-key (read-kbd-macro anything-command-map-prefix-key)
899 'anything-command-map))
901 (defcustom anything-command-map-prefix-key "<f5> a"
902 "*The prefix key for all `anything-command-map' commands.
904 !!WARNING!!
905 This default value is very likely to be changed,
906 because it is under discussion."
907 :type 'string
908 :set 'anything-set-anything-command-map-prefix-key
909 :group 'anything-config)
911 (defcustom anything-c-browse-code-regexp-lisp
912 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
913 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
914 "*Regexp used to parse lisp buffer when browsing code."
915 :type 'string
916 :group 'anything-config)
918 (defcustom anything-c-browse-code-regexp-python
919 "\\<def\\>\\|\\<class\\>"
920 "*Regexp used to parse python buffer when browsing code."
921 :type 'string
922 :group 'anything-config)
924 (defcustom anything-c-browse-code-regexp-alist
925 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
926 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
927 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
928 (python-mode . ,anything-c-browse-code-regexp-python))
929 "*Alist to store regexps for browsing code corresponding \
930 to a specific `major-mode'."
931 :type 'list
932 :group 'anything-config)
934 (defcustom anything-c-external-programs-associations nil
935 "*Alist to store externals programs associated with file extension.
936 This variable overhide setting in .mailcap file.
937 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
938 :type 'list
939 :group 'anything-config)
941 (defcustom anything-ff-auto-update-initial-value t
942 "Auto update when only one candidate directory is matched.
943 This is the default value when starting `anything-find-files'."
944 :group 'anything-config
945 :type 'boolean)
947 (defcustom anything-c-copy-async-prefered-emacs "emacs"
948 "Path to the emacs you want to use for copying async.
949 Emacs versions < 24 fail to copy directory due to a bug not fixed
950 in `copy-directory'."
951 :group 'anything-config
952 :type 'string)
954 (defcustom anything-ff-lynx-style-map t
955 "Use arrow keys to navigate with `anything-find-files'."
956 :group 'anything-config
957 :type 'boolean)
959 (defcustom anything-ff-history-max-length 100
960 "*Number of elements shown in `anything-find-files' history."
961 :group 'anything-config
962 :type 'integer)
964 (defcustom anything-ff-smart-completion t
965 "Try to complete filenames smarter when non--nil.
966 See `anything-ff-transform-fname-for-completion' for more info."
967 :group 'anything-config
968 :type 'boolean)
970 (defcustom anything-ff-default-kbsize 1024.0
971 "Default Kbsize to use for showing files size.
972 It is a float, usually 1024.0 but could be 1000.0 on some systems."
973 :group 'anything-config
974 :type 'float)
976 (defcustom anything-ff-tramp-not-fancy t
977 "No colors when listing remote files when set to non--nil.
978 This make listing much faster, specially on slow machines."
979 :group 'anything-config
980 :type 'boolean)
982 (defcustom anything-ff-exif-data-program "exiftran"
983 "*Program used to extract exif data of an image file."
984 :group 'anything-config
985 :type 'string)
987 (defcustom anything-ff-exif-data-program-args "-d"
988 "*Arguments used for `anything-ff-exif-data-program'."
989 :group 'anything-config
990 :type 'string)
992 (defcustom anything-c-grep-use-ioccur-style-keys t
993 "Use Arrow keys to jump to occurences."
994 :group 'anything-config
995 :type 'boolean)
997 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
998 "Default command to read pdf files from pdfgrep.
999 Where '%f' format spec is filename and '%p' is page number"
1000 :group 'anything-config
1001 :type 'string)
1003 (defcustom anything-c-etags-tag-file-name "TAGS"
1004 "Etags tag file name."
1005 :type 'string
1006 :group 'anything-config)
1008 (defcustom anything-c-etags-tag-file-search-limit 10
1009 "The limit level of directory to search tag file.
1010 Don't search tag file deeply if outside this value."
1011 :type 'number
1012 :group 'anything-config)
1014 (defcustom anything-c-filelist-file-name nil
1015 "Filename of file list.
1016 Accept a list of string for multiple files.
1018 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1019 File list is created by make-filelist.rb script.
1021 Usage:
1022 ruby make-filelist.rb > /tmp/all.filelist
1024 Then
1025 ;; Assume that /tmp is ramdisk or tmpfs
1026 \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1027 \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1029 :type 'string
1030 :group 'anything-config)
1032 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1033 'anything-c-eldoc-show-in-mode-line
1034 "A function to display eldoc info.
1035 Should take one arg: the string to display."
1036 :group 'anything-config
1037 :type 'symbol)
1039 (defcustom anything-c-turn-on-show-completion t
1040 "Display candidate in buffer while moving selection when non--nil."
1041 :group 'anything-config
1042 :type 'boolean)
1044 (defcustom anything-lisp-completion-or-indent-delay 0.6
1045 "After this delay `anything-lisp-completion-counter' is reset to 0.
1046 This allow to indent again without completing lisp symbol after this delay.
1047 Default is 0.6 seconds."
1048 :group 'anything-config
1049 :type 'number)
1051 (defcustom anything-c-default-external-file-browser "nautilus"
1052 "Default external file browser for your system.
1053 Directories will be opened externally with it.
1054 Set to nil if you do not have external file browser
1055 or do not want to use it."
1056 :group 'anything-config
1057 :type 'string)
1059 (defcustom anything-c-use-adaptative-sorting nil
1060 "*Wheter to use or not adaptative sorting.
1061 Even if a source use it, it will have no effect when set to nil."
1062 :type 'boolean
1063 :group 'anything-config)
1065 (defcustom anything-ff-newfile-prompt-p t
1066 "Whether Prompt or not when creating new file.
1067 This set `ffap-newfile-prompt'."
1068 :type 'boolean
1069 :group 'anything-config)
1072 (defcustom anything-ff-avfs-directory nil
1073 "*The default avfs directory, usually '.avfs'.
1074 When this is set you will be able to expand archive filenames with `C-z'
1075 inside an avfs directory mounted with mountavfs.
1076 See <http://sourceforge.net/projects/avf/>."
1077 :type 'boolean
1078 :group 'anything-config)
1080 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1081 "*Minimal list of compressed files extension."
1082 :type 'list
1083 :group 'anything-config)
1085 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1086 "Default regexp to match locate database.
1087 If nil Search in all files."
1088 :type 'string
1089 :group 'anything-config)
1091 (defcustom anything-c-eldoc-show-in-mode-line-delay 12
1092 "Eldoc will show info in mode-line during this delay if user is idle."
1093 :type 'integer
1094 :group 'anything-config)
1096 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1097 "The file used to communicate with two emacs when copying files async."
1098 :type 'string
1099 :group 'anything-config)
1101 (defcustom anything-ff-printer-list nil
1102 "A list of available printers on your system.
1103 When non--nil let you choose a printer to print file.
1104 Otherwise when nil the variable `printer-name' will be used.
1105 On Unix based systems you can use `anything-ff-find-printers' to
1106 find a list of available printers."
1107 :type 'list
1108 :group 'anything-config)
1112 ;;; General internal variables
1115 (defvar anything-c-external-commands-list nil
1116 "A list of all external commands the user can execute. If this
1117 variable is not set by the user, it will be calculated
1118 automatically.")
1121 ;;; Faces
1124 (defface anything-buffer-saved-out
1125 '((t (:foreground "red")))
1126 "*Face used for buffer files modified outside of emacs."
1127 :group 'anything-config)
1129 (defface anything-buffer-not-saved
1130 '((t (:foreground "Indianred2")))
1131 "*Face used for buffer files not already saved on disk."
1132 :group 'anything-config)
1134 (defface anything-ff-prefix
1135 '((t (:background "yellow" :foreground "black")))
1136 "*Face used to prefix new file or url paths in `anything-find-files'."
1137 :group 'anything-config)
1139 (defface anything-ff-executable
1140 '((t (:foreground "green")))
1141 "*Face used for executable files in `anything-find-files'."
1142 :group 'anything-config)
1144 (defface anything-ff-directory
1145 '((t (:foreground "DarkRed" :background "LightGray")))
1146 "*Face used for directories in `anything-find-files'."
1147 :group 'anything-config)
1149 (defface anything-ff-symlink
1150 '((t (:foreground "DarkOrange")))
1151 "*Face used for symlinks in `anything-find-files'."
1152 :group 'anything-config)
1154 (defface anything-ff-invalid-symlink
1155 '((t (:foreground "black" :background "red")))
1156 "*Face used for invalid symlinks in `anything-find-files'."
1157 :group 'anything-config)
1159 (defface anything-ff-file
1160 '((t (:foreground "CadetBlue" :underline t)))
1161 "*Face used for file names in `anything-find-files'."
1162 :group 'anything-config)
1164 (defface anything-grep-match
1165 '((t (:inherit match)))
1166 "Face used to highlight grep matches."
1167 :group 'anything-config)
1169 (defface anything-grep-file
1170 '((t (:foreground "BlueViolet" :underline t)))
1171 "Face used to highlight grep results filenames."
1172 :group 'anything-config)
1174 (defface anything-grep-lineno
1175 '((t (:foreground "Darkorange1")))
1176 "Face used to highlight grep number lines."
1177 :group 'anything-config)
1179 (defface anything-grep-running
1180 '((t (:foreground "Red")))
1181 "Face used in mode line when grep is running."
1182 :group 'anything-config)
1184 (defface anything-grep-finish
1185 '((t (:foreground "Green")))
1186 "Face used in mode line when grep is finish."
1187 :group 'anything-config)
1189 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1190 "*Face used in anything-M-x to show keybinding."
1191 :group 'anything)
1193 (defface anything-bmkext-info
1194 '((t (:foreground "green")))
1195 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1196 :group 'anything)
1198 (defface anything-bmkext-w3m
1199 '((t (:foreground "yellow")))
1200 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1201 :group 'anything)
1203 (defface anything-bmkext-gnus
1204 '((t (:foreground "magenta")))
1205 "*Face used for Gnus bookmarks."
1206 :group 'anything)
1208 (defface anything-bmkext-man
1209 '((t (:foreground "Orange4")))
1210 "*Face used for Woman/man bookmarks."
1211 :group 'anything)
1213 (defface anything-bmkext-no--file
1214 '((t (:foreground "grey")))
1215 "*Face used for non--file bookmarks."
1216 :group 'anything)
1218 (defface anything-bmkext-file
1219 '((t (:foreground "Deepskyblue2")))
1220 "*Face used for non--file bookmarks."
1221 :group 'anything)
1223 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1224 "Face for su/sudo bookmarks."
1225 :group 'anything)
1227 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1228 "Face for w3m bookmarks" :group 'anything)
1230 (defface anything-emms-playlist
1231 '((t (:foreground "Springgreen4" :underline t)))
1232 "*Face used for tracks in current emms playlist."
1233 :group 'anything)
1235 (defface anything-apt-installed
1236 '((t (:foreground "green")))
1237 "*Face used for apt installed candidates."
1238 :group 'anything)
1240 (defface anything-gentoo-match-face '((t (:foreground "red")))
1241 "Face for anything-gentoo installed packages."
1242 :group 'traverse-faces)
1244 (defface anything-lisp-show-completion
1245 '((t (:background "DarkSlateGray")))
1246 "*Face used for showing candidates in `anything-lisp-completion'."
1247 :group 'anything-config)
1249 (defface anything-lisp-completion-info
1250 '((t (:foreground "red")))
1251 "*Face used for showing info in `anything-lisp-completion'."
1252 :group 'anything-config)
1254 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1255 "Face for source header in the anything buffer." :group 'anything)
1257 ;;;###autoload
1258 (defun anything-configuration ()
1259 "Customize `anything'."
1260 (interactive)
1261 (customize-group "anything-config"))
1265 ;;; Anything-command-map
1268 ;;;###autoload
1269 (defvar anything-command-map)
1270 (define-prefix-command 'anything-command-map)
1273 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1274 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1275 (define-key anything-command-map (kbd "l") 'anything-locate)
1276 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1277 (define-key anything-command-map (kbd "r") 'anything-regexp)
1278 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1279 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1280 (define-key anything-command-map (kbd "#") 'anything-emms)
1281 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1282 (define-key anything-command-map (kbd "t") 'anything-top)
1283 (define-key anything-command-map (kbd "i") 'anything-imenu)
1284 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1285 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1286 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1287 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1288 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1289 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1290 (define-key anything-command-map (kbd "f") 'anything-for-files)
1291 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1292 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1293 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1294 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1295 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1296 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1297 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1298 (define-key anything-command-map (kbd "c") 'anything-colors)
1299 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1300 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1301 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1302 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1303 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1304 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1305 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
1306 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1307 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1308 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1310 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1311 ;; minibuffer-local-filename-must-match-map.
1312 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1313 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1314 (dolist (map (list minibuffer-local-filename-completion-map
1315 minibuffer-local-completion-map
1316 minibuffer-local-must-match-filename-map
1317 minibuffer-local-filename-must-match-map
1318 minibuffer-local-map
1319 minibuffer-local-isearch-map
1320 minibuffer-local-must-match-map
1321 minibuffer-local-ns-map))
1322 (define-key map "\C-r" 'anything-minibuffer-history))
1326 ;;; Menu
1329 (easy-menu-define nil global-map
1330 "`anything' menu"
1331 '("Anything"
1332 ["All anything commands" anything-execute-anything-command t]
1333 ["Find any Files/Buffers" anything-for-files t]
1334 "----"
1335 ("Files:"
1336 ["Find files" anything-find-files t]
1337 ["Recent Files" anything-recentf t]
1338 ["Locate" anything-locate t]
1339 ["Bookmarks" anything-c-pp-bookmarks t])
1340 ("Buffers:"
1341 ["Find buffers" anything-buffers-list t])
1342 ("Commands:"
1343 ["Emacs Commands" anything-M-x t]
1344 ["Externals Commands" anything-c-run-external-command t])
1345 ("Info:"
1346 ["Info at point" anything-info-at-point t]
1347 ["Emacs Manual index" anything-info-emacs t]
1348 ["Gnus Manual index" anything-info-gnus t])
1349 ("Org:"
1350 ["Org keywords" anything-org-keywords t]
1351 ["Org headlines" anything-org-headlines t])
1352 ("Tools:"
1353 ["Occur" anything-occur t]
1354 ["Grep" anything-do-grep t]
1355 ["Etags" anything-c-etags-select t]
1356 ["Lisp complete at point" anything-lisp-completion-at-point t]
1357 ["Browse Kill ring" anything-show-kill-ring t]
1358 ["Browse register" anything-register t]
1359 ["Browse code" anything-browse-code t]
1360 ["Mark Ring" anything-all-mark-rings t]
1361 ["Regexp handler" anything-regexp t]
1362 ["Colors & Faces" anything-colors t]
1363 ["Show xfonts" anything-select-xfont t]
1364 ["Imenu" anything-imenu t]
1365 ["Google Suggest" anything-google-suggest t]
1366 ["Eval expression" anything-eval-expression-with-eldoc t]
1367 ["Calcul expression" anything-calcul-expression t]
1368 ["Man pages" anything-man-woman t]
1369 ["Top externals process" anything-top t]
1370 ["Emacs internals process" anything-list-emacs-process t])
1371 "----"
1372 ["Prefered Options" anything-configuration t]))
1376 ;;; Specialized keymaps
1379 (defvar anything-c-buffer-map
1380 (let ((map (copy-keymap anything-map)))
1381 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
1382 ;; No need to have separate command for grep and zgrep
1383 ;; as we don't use recursivity for buffers.
1384 ;; So use zgrep for both as it is capable to handle non--compressed files.
1385 (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
1386 (define-key map (kbd "C-o") 'anything-buffer-switch-other-window)
1387 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
1388 (define-key map (kbd "C-c =") 'anything-buffer-run-ediff)
1389 (define-key map (kbd "M-=") 'anything-buffer-run-ediff-merge)
1390 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
1391 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
1392 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
1393 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
1394 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
1395 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
1396 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1397 (define-key map (kbd "M-a") 'anything-mark-all)
1398 (when (locate-library "elscreen")
1399 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1400 (delq nil map))
1401 "Keymap for buffer sources in anything.")
1403 (defvar anything-find-files-map
1404 (let ((map (copy-keymap anything-map)))
1405 (define-key map (kbd "C-]") 'anything-ff-run-toggle-basename)
1406 (define-key map (kbd "C-x C-f") 'anything-ff-run-locate)
1407 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1408 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1409 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1410 (define-key map (kbd "M-.") 'anything-ff-run-etags)
1411 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
1412 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
1413 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
1414 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
1415 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
1416 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1417 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
1418 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
1419 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
1420 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1421 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
1422 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1423 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
1424 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1425 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1426 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
1427 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1428 (define-key map (kbd "C-c ?") 'anything-ff-help)
1429 (define-key map (kbd "C-}") 'anything-narrow-window)
1430 (define-key map (kbd "C-{") 'anything-enlarge-window)
1431 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1432 (define-key map (kbd "M-a") 'anything-mark-all)
1433 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1434 (define-key map (kbd "M-u") 'anything-unmark-all)
1435 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
1436 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
1437 ;; Next 2 have no effect if candidate is not an image file.
1438 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
1439 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
1440 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1441 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1442 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
1443 (define-key map (kbd "C-h C-d") 'anything-debug-output)
1444 (when anything-ff-lynx-style-map
1445 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1446 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
1447 (delq nil map))
1448 "Keymap for `anything-find-files'.")
1450 (defvar anything-c-read-file-map
1451 (let ((map (copy-keymap anything-map)))
1452 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1453 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1454 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1455 (when anything-ff-lynx-style-map
1456 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1457 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
1458 (define-key map (kbd "<M-left>") 'anything-previous-source)
1459 (define-key map (kbd "<M-right>") 'anything-next-source))
1460 (delq nil map))
1461 "Keymap for `anything-c-read-file-name'.")
1463 (defvar anything-generic-files-map
1464 (let ((map (copy-keymap anything-map)))
1465 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1466 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1467 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1468 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1469 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1470 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1471 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1472 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
1473 map)
1474 "Generic Keymap for files.")
1476 (defvar anything-c-grep-map
1477 (let ((map (copy-keymap anything-map)))
1478 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1479 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1480 (define-key map (kbd "C-o") 'anything-c-grep-run-other-window-action)
1481 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1482 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
1483 (when anything-c-grep-use-ioccur-style-keys
1484 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
1485 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
1486 (define-key map (kbd "C-c ?") 'anything-grep-help)
1487 (delq nil map))
1488 "Keymap used in Grep sources.")
1490 (defvar anything-c-pdfgrep-map
1491 (let ((map (copy-keymap anything-map)))
1492 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1493 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1494 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1495 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
1496 map)
1497 "Keymap used in pdfgrep.")
1499 (defvar anything-c-etags-map
1500 (let ((map (copy-keymap anything-map)))
1501 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1502 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1503 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1504 (define-key map (kbd "C-c ?") 'anything-etags-help)
1505 map)
1506 "Keymap used in Etags.")
1508 (defvar anything-eval-expression-map
1509 (let ((map (copy-keymap anything-map)))
1510 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1511 (define-key map (kbd "<tab>") 'lisp-indent-line)
1512 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
1513 (define-key map (kbd "C-p") 'previous-line)
1514 (define-key map (kbd "C-n") 'next-line)
1515 (define-key map (kbd "<up>") 'previous-line)
1516 (define-key map (kbd "<down>") 'next-line)
1517 (define-key map (kbd "<right>") 'forward-char)
1518 (define-key map (kbd "<left>") 'backward-char)
1519 map))
1523 ;;; Embeded documentation.
1526 (defun anything-c-list-preconfigured-anything ()
1527 "Collect preconfigured anything functions in this file."
1528 (loop with doc
1529 with sym
1530 for entry in (cdr (assoc
1531 (file-truename (locate-library "anything-config"))
1532 load-history))
1533 if (and (consp entry)
1534 (eq (car entry) 'defun)
1535 (string-match "^Preconfigured.+$"
1536 (setq doc (or (documentation (setq sym (cdr entry)))
1537 ""))))
1538 collect (cons sym (match-string 0 doc))))
1540 (defun anything-c-format-preconfigured-anything ()
1541 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1542 (anything-c-list-preconfigured-anything)))
1544 ;;; Global help message - Used by `anything-help'
1547 (setq anything-help-message
1548 (lambda ()
1549 (concat
1550 "\\<anything-map>"
1551 "`anything' is QuickSilver-like candidate-selection framework.
1553 Narrow the list by typing some pattern,
1554 Multiple patterns are allowed by splitting by space.
1555 Select with natural Emacs operations, choose with RET.
1557 If you have any problems, press C-c C-x C-b!!
1558 Feel free to send bug reports. I'll fix them.
1559 The steps are described in the beginning of anything.el file.
1561 == Basic Operations ==
1562 C-p, Up: Previous Line
1563 C-n, Down : Next Line
1564 M-v, PageUp : Previous Page
1565 C-v, PageDown : Next Page
1566 Enter : Execute first (default) action / Select
1567 M-< : First Line
1568 M-> : Last Line
1569 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1570 M-PageDown, C-M-v : Next Page (other-window)
1572 Tab, C-i : Show action list
1573 Left : Previous Source
1574 Right, C-o : Next Source
1575 C-k : Delete pattern
1576 C-z : Persistent Action (Execute action with anything session kept)
1577 C-c C-x C-b: Send a bug report
1579 == Shortcuts For 2nd/3rd Action ==
1580 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1581 \\[anything-select-3rd-action] : Execute 3rd Action
1583 == Visible Marks ==
1584 Visible marks store candidate. Some actions uses marked candidates.
1586 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1587 \\[anything-prev-visible-mark] : Previous Mark
1588 \\[anything-next-visible-mark] : Next Mark
1590 == Miscellaneous Commands ==
1591 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1592 \\[anything-quit-and-find-file] : Drop into `find-file'
1593 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1594 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1595 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1596 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1597 \\[anything-force-update] : Recalculate And Redisplay Candidates
1599 == Global Commands ==
1600 \\<global-map>\\[anything-resume] revives last `anything' session.
1601 It is very useful, so you should bind any key.
1603 Single source is executed by \\[anything-call-source].
1605 == Preconfigured `anything' ==
1606 Preconfigured `anything' is commands that uses `anything' interface.
1607 You can use them without configuration.
1610 (apply 'concat (anything-c-format-preconfigured-anything))
1612 Enjoy!")))
1614 ;;; `anything-buffer-list' help
1617 ;;;###autoload
1618 (defun anything-c-buffer-help ()
1619 "Help command for anything buffers."
1620 (interactive)
1621 (let ((anything-help-message "== Anything Buffer ==
1622 \nTips:
1623 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1624 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1625 \nSpecific commands for `anything-buffers-list':
1626 \\<anything-c-buffer-map>
1627 \\[anything-buffer-run-zgrep]\t\t->Grep Buffer(s) works as zgrep too. (C-u grep all buffers but non--file buffers).
1628 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1629 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1630 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1631 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1632 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1633 \\[anything-buffer-run-ediff]\t\t->Ediff current buffer with candidate. If two marked buffers ediff those buffers.
1634 \\[anything-buffer-run-ediff-merge]\t\t->Ediff merge current buffer with candidate. If two marked buffers ediff merge those buffers.
1635 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer with saved file without quitting.
1636 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1637 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1638 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1639 \\[anything-toggle-all-marks]\t\t->Toggle all marks.
1640 \\[anything-mark-all]\t\t->Mark all.
1641 \\[anything-c-buffer-help]\t\t->Display this help.
1642 \n== Anything Map ==
1643 \\{anything-map}
1645 (anything-help)))
1648 ;;; Find files help (`anything-find-files')
1651 ;;;###autoload
1652 (defun anything-ff-help ()
1653 "Help command for `anything-find-files'."
1654 (interactive)
1655 (let ((anything-help-message "== Anything Find Files ==
1656 \nTips:
1657 \nEnter \"~/\" at anytime to reach home directory.
1658 Enter \"/\" at anytime to reach root of your file system.
1659 You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1660 Use `C-u C-z' to watch an image.
1661 To browse images directories turn on `anything-follow-mode'.
1662 \nSpecific commands for `anything-find-files':
1663 \\<anything-find-files-map>
1664 \\[anything-ff-run-locate]\t\t->Run Locate on basename of candidate (C-u to specify locate db).
1665 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1666 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1667 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1668 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1669 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1670 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1671 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1672 \\[anything-ff-run-load-file]\t\t->Load File.
1673 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1674 \\[anything-ff-run-delete-file]\t\t->Delete File.
1675 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1676 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1677 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1678 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1679 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1680 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1681 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1682 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1683 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1684 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1685 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1686 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1687 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1688 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1689 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1690 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1691 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1692 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1693 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
1694 \\[anything-enlarge-window]\t\t->Enlarge anything window.
1695 \\[anything-narrow-window]\t\t->Narrow anything window.
1696 \\[anything-ff-run-toggle-basename]\t\t->Toggle basename/fullpath.
1697 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1698 \\[anything-ff-help]\t\t->Display this help info.
1699 \n== Anything Map ==
1700 \\{anything-map}
1702 (anything-help)))
1704 ;;; Generic file help - Used by locate.
1707 ;;;###autoload
1708 (defun anything-generic-file-help ()
1709 (interactive)
1710 (let ((anything-help-message "== Anything Generic files Map ==\
1711 \nSpecific commands for anything locate and others files sources:
1712 \\<anything-generic-files-map>
1713 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
1714 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1715 \\[anything-ff-run-delete-file]\t\t->Delete file.
1716 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1717 \\[anything-ff-properties-persistent]\t\t->Show file properties.
1718 \\[anything-yank-text-at-point]\t\t->Yank text at point.
1719 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1720 \nLocate tips:
1721 You can add after writing search pattern any of the locate command line options.
1722 e.g -b, -e, -n <number>...etc.
1723 See Man locate for more infos.
1724 \n== Anything Map ==
1725 \\{anything-map}"))
1726 (anything-help)))
1729 ;;; Grep help
1732 ;;;###autoload
1733 (defun anything-grep-help ()
1734 (interactive)
1735 (let ((anything-help-message "== Anything Grep Map ==\
1736 \nSpecific commands for Grep and Etags:
1737 \\<anything-c-grep-map>
1738 \\[anything-c-goto-next-file]\t->Next File.
1739 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1740 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1741 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
1742 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
1743 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
1744 \\[anything-grep-help]\t\t->Show this help.
1745 \n== Anything Map ==
1746 \\{anything-map}"))
1747 (anything-help)))
1749 ;;; Pdf grep help
1752 ;;;###autoload
1753 (defun anything-pdfgrep-help ()
1754 (interactive)
1755 (let ((anything-help-message "== Anything PdfGrep Map ==\
1756 \nSpecific commands for Pdf Grep:
1757 \\<anything-c-pdfgrep-map>
1758 \\[anything-c-goto-next-file]\t->Next File.
1759 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1760 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1761 \\[anything-pdfgrep-help]\t\t->Show this help.
1762 \n== Anything Map ==
1763 \\{anything-map}"))
1764 (anything-help)))
1766 ;;; Etags help
1769 ;;;###autoload
1770 (defun anything-etags-help ()
1771 "The help function for etags."
1772 (interactive)
1773 (let ((anything-help-message "== Anything Etags Map ==\
1774 \nSpecific commands for Etags:
1775 \\<anything-c-etags-map>
1776 \\[anything-c-goto-next-file]\t->Next File.
1777 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1778 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1779 \\[anything-etags-help]\t\t->Show this help.
1780 \n== Anything Map ==
1781 \\{anything-map}"))
1782 (anything-help)))
1786 ;;; Mode line strings
1789 (defvar anything-buffer-mode-line-string
1790 '("Buffer(s)"
1791 "\\<anything-c-buffer-map>\
1792 \\[anything-c-buffer-help]:Help, \
1793 \\<anything-map>\
1794 \\[anything-select-action]:Acts,\
1795 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1796 \\[anything-select-3rd-action]:NthAct,\
1797 \\[anything-send-bug-report-from-anything]:BugReport."
1798 "String displayed in mode-line in `anything-c-source-buffers-list'"))
1800 (defvar anything-ff-mode-line-string
1801 "\\<anything-find-files-map>\
1802 \\[anything-ff-help]:Help, \
1803 \\[anything-send-bug-report-from-anything]:BugReport, \
1804 \\<anything-map>\
1805 \\[anything-select-action]:Acts, \
1806 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1807 \\[anything-select-3rd-action]:NthAct"
1808 "String displayed in mode-line in `anything-c-source-find-files'")
1810 (defvar anything-generic-file-mode-line-string
1811 "\\<anything-generic-files-map>\
1812 \\[anything-generic-file-help]:Help, \
1813 \\<anything-map>\
1814 \\[anything-select-action]:Acts,\
1815 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1816 \\[anything-select-3rd-action]:NthAct,\
1817 \\[anything-send-bug-report-from-anything]:BugReport."
1818 "String displayed in mode-line in `anything-c-source-find-files'")
1820 (defvar anything-grep-mode-line-string
1821 "\\<anything-c-grep-map>\
1822 \\[anything-grep-help]:Help,\
1823 \\<anything-map>\
1824 \\[anything-select-action]:Acts,\
1825 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1826 \\[anything-select-3rd-action]:NthAct,\
1827 \\[anything-send-bug-report-from-anything]:BugReport."
1828 "String displayed in mode-line in `anything-do-grep'.")
1830 (defvar anything-pdfgrep-mode-line-string
1831 "\\<anything-c-pdfgrep-map>\
1832 \\[anything-pdfgrep-help]:Help,\
1833 \\<anything-map>\
1834 \\[anything-select-action]:Acts,\
1835 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1836 \\[anything-select-3rd-action]:NthAct,\
1837 \\[anything-send-bug-report-from-anything]:BugReport."
1838 "String displayed in mode-line in `anything-do-pdfgrep'.")
1840 (defvar anything-etags-mode-line-string
1841 "\\<anything-c-etags-map>\
1842 \\[anything-etags-help]:Help,\
1843 \\<anything-map>\
1844 \\[anything-select-action]:Acts,\
1845 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1846 \\[anything-select-3rd-action]:NthAct,\
1847 \\[anything-send-bug-report-from-anything]:BugReport."
1848 "String displayed in mode-line in `anything-c-etags-select'.")
1852 ;;; Preconfigured Anything
1855 ;;;###autoload
1856 (defun anything-mini ()
1857 "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
1858 (interactive)
1859 (anything-other-buffer '(anything-c-source-buffers-list anything-c-source-recentf)
1860 "*anything mini*"))
1861 ;;;###autoload
1862 (defun anything-for-files ()
1863 "Preconfigured `anything' for opening files.
1864 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
1865 (interactive)
1866 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
1868 ;;;###autoload
1869 (defun anything-recentf ()
1870 "Preconfigured `anything' for `recentf'."
1871 (interactive)
1872 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
1874 ;;;###autoload
1875 (defun anything-info-at-point (arg)
1876 "Preconfigured `anything' for searching info at point.
1877 With a prefix-arg insert symbol at point."
1878 (interactive "P")
1879 (let ((anything-c-google-suggest-default-function
1880 'anything-c-google-suggest-emacs-lisp))
1881 (anything :sources'(anything-c-source-info-elisp
1882 anything-c-source-info-cl
1883 anything-c-source-info-pages
1884 anything-c-source-google-suggest)
1885 :input (and arg (thing-at-point 'symbol))
1886 :buffer "*anything info*")))
1888 ;;;###autoload
1889 (defun anything-info-emacs ()
1890 "Preconfigured anything for Emacs manual index."
1891 (interactive)
1892 (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
1894 ;;;###autoload
1895 (defun anything-show-kill-ring ()
1896 "Preconfigured `anything' for `kill-ring'.
1897 It is drop-in replacement of `yank-pop'.
1898 You may bind this command to M-y.
1899 First call open the kill-ring browser, next calls move to next line."
1900 (interactive)
1901 (let ((buf "*anything kill-ring*"))
1902 (if (get-buffer-window buf)
1903 (with-anything-window
1904 (if (eq (overlay-end anything-selection-overlay) (point-max))
1905 (anything-beginning-of-buffer)
1906 (anything-next-line)))
1907 (anything-other-buffer 'anything-c-source-kill-ring buf))))
1909 ;;;###autoload
1910 (defun anything-minibuffer-history ()
1911 "Preconfigured `anything' for `minibuffer-history'."
1912 (interactive)
1913 (let ((enable-recursive-minibuffers t))
1914 (anything-other-buffer 'anything-c-source-minibuffer-history
1915 "*anything minibuffer-history*")))
1917 ;;;###autoload
1918 (defun anything-gentoo ()
1919 "Preconfigured `anything' for gentoo linux."
1920 (interactive)
1921 (anything-other-buffer '(anything-c-source-gentoo
1922 anything-c-source-use-flags)
1923 "*anything gentoo*"))
1925 ;;;###autoload
1926 (defun anything-imenu ()
1927 "Preconfigured `anything' for `imenu'."
1928 (interactive)
1929 (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*"))
1931 ;;;###autoload
1932 (defun anything-google-suggest ()
1933 "Preconfigured `anything' for google search with google suggest."
1934 (interactive)
1935 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
1937 ;;;###autoload
1938 (defun anything-yahoo-suggest ()
1939 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
1940 (interactive)
1941 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
1943 ;;; Converted from anything-show-*-only
1944 ;;;###autoload
1945 (defun anything-for-buffers ()
1946 "Preconfigured `anything' for buffer."
1947 (interactive)
1948 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
1950 ;;;###autoload
1951 (defun anything-buffers-list ()
1952 "Enhanced preconfigured `anything' for buffer."
1953 (interactive)
1954 (anything :sources '(anything-c-source-buffers-list
1955 anything-c-source-buffer-not-found)
1956 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
1958 ;;;###autoload
1959 (defun anything-bbdb ()
1960 "Preconfigured `anything' for BBDB.
1962 Needs BBDB.
1964 http://bbdb.sourceforge.net/"
1965 (interactive)
1966 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
1968 ;;;###autoload
1969 (defun anything-locate (arg)
1970 "Preconfigured `anything' for Locate.
1971 Note: you can add locate options after entering pattern.
1972 See 'man locate' for valid options.
1974 You can specify a specific database with prefix argument ARG \(C-u\).
1975 Many databases can be used: navigate and mark them.
1976 See also `anything-locate-with-db'.
1978 To create a user specific db, use
1979 \"updatedb -l 0 -o db_path -U directory\".
1980 Where db_path is a filename matched by
1981 `anything-locate-db-file-regexp'."
1982 (interactive "P")
1983 (anything-locate-1 arg))
1985 ;;;###autoload
1986 (defun anything-w3m-bookmarks ()
1987 "Preconfigured `anything' for w3m bookmark.
1989 Needs w3m and emacs-w3m.
1991 http://w3m.sourceforge.net/
1992 http://emacs-w3m.namazu.org/"
1993 (interactive)
1994 (anything-other-buffer 'anything-c-source-w3m-bookmarks
1995 "*anything w3m bookmarks*"))
1997 ;;;###autoload
1998 (defun anything-firefox-bookmarks ()
1999 "Preconfigured `anything' for firefox bookmark.
2000 You will have to enable html bookmarks in firefox:
2001 open about:config in firefox and double click on this line to enable value \
2002 to true:
2004 user_pref(\"browser.bookmarks.autoExportHTML\", false);
2006 You should have now:
2008 user_pref(\"browser.bookmarks.autoExportHTML\", true);
2010 After closing firefox, you will be able to browse you bookmarks.
2012 (interactive)
2013 (anything-other-buffer 'anything-c-source-firefox-bookmarks
2014 "*Anything Firefox*"))
2016 ;;;###autoload
2017 (defun anything-colors ()
2018 "Preconfigured `anything' for color."
2019 (interactive)
2020 (anything-other-buffer
2021 '(anything-c-source-colors anything-c-source-customize-face)
2022 "*anything colors*"))
2024 ;;;###autoload
2025 (defun anything-bookmarks ()
2026 "Preconfigured `anything' for bookmarks."
2027 (interactive)
2028 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
2030 ;;;###autoload
2031 (defun anything-c-pp-bookmarks ()
2032 "Preconfigured `anything' for bookmarks (pretty-printed)."
2033 (interactive)
2034 (anything-other-buffer '(anything-c-source-bookmarks-local
2035 anything-c-source-bookmarks-su
2036 anything-c-source-bookmarks-ssh)
2037 "*anything pp bookmarks*"))
2039 ;;;###autoload
2040 (defun anything-c-insert-latex-math ()
2041 "Preconfigured anything for latex math symbols completion."
2042 (interactive)
2043 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
2045 ;;;###autoload
2046 (defun anything-register ()
2047 "Preconfigured `anything' for Emacs registers."
2048 (interactive)
2049 (anything-other-buffer 'anything-c-source-register "*anything register*"))
2051 ;;;###autoload
2052 (defun anything-man-woman ()
2053 "Preconfigured `anything' for Man and Woman pages."
2054 (interactive)
2055 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
2057 ;;;###autoload
2058 (defun anything-org-keywords ()
2059 "Preconfigured `anything' for org keywords."
2060 (interactive)
2061 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
2063 ;;;###autoload
2064 (defun anything-emms ()
2065 "Preconfigured `anything' for emms sources."
2066 (interactive)
2067 (anything '(anything-c-source-emms-streams
2068 anything-c-source-emms-files
2069 anything-c-source-emms-dired)
2070 nil nil nil nil
2071 "*Anything Emms*"))
2073 ;;;###autoload
2074 (defun anything-eev-anchors ()
2075 "Preconfigured `anything' for eev anchors."
2076 (interactive)
2077 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
2079 ;;;###autoload
2080 (defun anything-bm-list ()
2081 "Preconfigured `anything' for visible bookmarks.
2083 Needs bm.el
2085 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
2086 (interactive)
2087 (let ((anything-outline-using t))
2088 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
2090 ;;;###autoload
2091 (defun anything-timers ()
2092 "Preconfigured `anything' for timers."
2093 (interactive)
2094 (anything-other-buffer '(anything-c-source-absolute-time-timers
2095 anything-c-source-idle-time-timers)
2096 "*anything timers*"))
2098 ;;;###autoload
2099 (defun anything-list-emacs-process ()
2100 "Preconfigured `anything' for emacs process."
2101 (interactive)
2102 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
2104 ;;;###autoload
2105 (defun anything-occur ()
2106 "Preconfigured Anything for Occur source.
2107 If region is active, search only in region,
2108 otherwise search in whole buffer."
2109 (interactive)
2110 (let ((anything-compile-source-functions
2111 ;; rule out anything-match-plugin because the input is one regexp.
2112 (delq 'anything-compile-source--match-plugin
2113 (copy-sequence anything-compile-source-functions))))
2114 (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
2116 ;;;###autoload
2117 (defun anything-browse-code ()
2118 "Preconfigured anything to browse code."
2119 (interactive)
2120 (anything-other-buffer 'anything-c-source-browse-code "*Browse code*"))
2122 ;;;###autoload
2123 (defun anything-org-headlines ()
2124 "Preconfigured anything to show org headlines."
2125 (interactive)
2126 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
2128 ;;;###autoload
2129 (defun anything-info-gnus ()
2130 "Preconfigured anything to browse Gnus Manual."
2131 (interactive)
2132 (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
2134 ;;;###autoload
2135 (defun anything-regexp ()
2136 "Preconfigured anything to build regexps and run query-replace-regexp \
2137 against."
2138 (interactive)
2139 (save-restriction
2140 (let ((anything-compile-source-functions
2141 ;; rule out anything-match-plugin because the input is one regexp.
2142 (delq 'anything-compile-source--match-plugin
2143 (copy-sequence anything-compile-source-functions))))
2144 (when (and (anything-region-active-p)
2145 ;; Don't narrow to region if buffer is already narrowed.
2146 (not (anything-current-buffer-narrowed-p)))
2147 (narrow-to-region (region-beginning) (region-end)))
2148 (anything :sources
2149 anything-c-source-regexp
2150 :buffer "*anything regexp*"
2151 :prompt "Regexp: "))))
2153 (defun anything-c-copy-files-async ()
2154 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
2155 (interactive)
2156 (let* ((flist (anything-c-read-file-name
2157 "Copy File async: "
2158 :marked-candidates t))
2159 (dest (anything-c-read-file-name
2160 "Copy File async To: "
2161 :preselect (car flist)
2162 :initial-input (car anything-ff-history)
2163 :history (anything-find-files-history :comp-read nil))))
2164 (anything-c-copy-async-with-log flist dest)))
2166 ;;;###autoload
2167 (defun anything-find-files (arg)
2168 "Preconfigured `anything' for anything implementation of `find-file'.
2169 Called with a prefix arg show history if some.
2170 Don't call it from programs, use `anything-find-files-1' instead.
2171 This is the starting point for nearly all actions you can do on files."
2172 (interactive "P")
2173 (let ((any-input (if (and arg anything-ff-history)
2174 (anything-find-files-history)
2175 (anything-find-files-initial-input)))
2176 (presel (buffer-file-name (current-buffer))))
2177 (when (and (eq major-mode 'org-agenda-mode)
2178 org-directory
2179 (not any-input))
2180 (setq any-input (expand-file-name org-directory)))
2181 (set-text-properties 0 (length any-input) nil any-input)
2182 (if any-input
2183 (anything-find-files-1 any-input)
2184 (setq any-input (expand-file-name (anything-c-current-directory)))
2185 (anything-find-files-1
2186 any-input (if anything-ff-transformer-show-only-basename
2187 (and presel (anything-c-basename presel))
2188 presel)))))
2190 ;;;###autoload
2191 (defun anything-write-file ()
2192 "Preconfigured `anything' providing completion for `write-file'."
2193 (interactive)
2194 (let ((anything-mp-highlight-delay nil))
2195 (anything :sources 'anything-c-source-write-file
2196 :input (expand-file-name default-directory)
2197 :prompt "Write buffer to file: "
2198 :buffer "*Anything write file*")))
2200 ;;;###autoload
2201 (defun anything-insert-file ()
2202 "Preconfigured `anything' providing completion for `insert-file'."
2203 (interactive)
2204 (let ((anything-mp-highlight-delay nil))
2205 (anything :sources 'anything-c-source-insert-file
2206 :input (expand-file-name default-directory)
2207 :prompt "Insert file: "
2208 :buffer "*Anything insert file*")))
2210 ;;;###autoload
2211 (defun anything-dired-rename-file ()
2212 "Preconfigured `anything' to rename files from dired."
2213 (interactive)
2214 (anything-dired-do-action-on-file :action 'rename))
2216 ;;;###autoload
2217 (defun anything-dired-copy-file ()
2218 "Preconfigured `anything' to copy files from dired."
2219 (interactive)
2220 (anything-dired-do-action-on-file :action 'copy))
2222 ;;;###autoload
2223 (defun anything-dired-symlink-file ()
2224 "Preconfigured `anything' to symlink files from dired."
2225 (interactive)
2226 (anything-dired-do-action-on-file :action 'symlink))
2228 ;;;###autoload
2229 (defun anything-dired-hardlink-file ()
2230 "Preconfigured `anything' to hardlink files from dired."
2231 (interactive)
2232 (anything-dired-do-action-on-file :action 'hardlink))
2234 ;;;###autoload
2235 (defun anything-do-grep ()
2236 "Preconfigured anything for grep.
2237 Contrarily to Emacs `grep' no default directory is given, but
2238 the full path of candidates in ONLY.
2239 That allow to grep different files not only in `default-directory' but anywhere
2240 by marking them (C-<SPACE>). If one or more directory is selected
2241 grep will search in all files of these directories.
2242 You can use also wildcard in the base name of candidate.
2243 If a prefix arg is given use the -r option of grep.
2244 The prefix arg can be passed before or after start.
2245 See also `anything-do-grep-1'."
2246 (interactive)
2247 (let ((only (anything-c-read-file-name
2248 "Search in file(s): "
2249 :marked-candidates t
2250 :preselect (or (dired-get-filename nil t)
2251 (buffer-file-name (current-buffer)))))
2252 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
2253 (anything-do-grep-1 only prefarg)))
2255 ;;;###autoload
2256 (defun anything-do-zgrep (candidate)
2257 "Preconfigured anything for zgrep."
2258 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
2259 (ls (anything-c-read-file-name
2260 "Search in file(s): "
2261 :marked-candidates t
2262 :preselect (or (dired-get-filename nil t)
2263 (buffer-file-name (current-buffer))))))
2264 (anything-ff-zgrep-1 ls prefarg)))
2266 (defun anything-c-etags-select (arg)
2267 "Preconfigured anything for etags.
2268 Called with one prefix arg use symbol at point as initial input.
2269 Called with two prefix arg reinitialize cache.
2270 If tag file have been modified reinitialize cache."
2271 (interactive "P")
2272 (let ((tag (anything-c-etags-get-tag-file))
2273 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
2274 (anything-quit-if-no-candidate t)
2275 (anything-execute-action-at-once-if-one t))
2276 (when (or (equal arg '(16))
2277 (and anything-c-etags-mtime-alist
2278 (anything-c-etags-file-modified-p tag)))
2279 (remhash tag anything-c-etags-cache))
2280 (if (and tag (file-exists-p tag))
2281 (anything :sources 'anything-c-source-etags-select
2282 :keymap anything-c-etags-map
2283 :input init
2284 :buffer "*anything etags*")
2285 (message "Error: No tag file found, please create one with etags shell command."))))
2287 ;;;###autoload
2288 (defun anything-filelist ()
2289 "Preconfigured `anything' to open files instantly.
2291 See `anything-c-filelist-file-name' docstring for usage."
2292 (interactive)
2293 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
2295 ;;;###autoload
2296 (defun anything-filelist+ ()
2297 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
2299 This is a replacement for `anything-for-files'.
2300 See `anything-c-filelist-file-name' docstring for usage."
2301 (interactive)
2302 (anything-other-buffer
2303 '(anything-c-source-ffap-line
2304 anything-c-source-ffap-guesser
2305 anything-c-source-buffers-list
2306 anything-c-source-recentf
2307 anything-c-source-bookmarks
2308 anything-c-source-file-cache
2309 anything-c-source-filelist)
2310 "*anything file list*"))
2312 ;;;###autoload
2313 (defun anything-M-x ()
2314 "Preconfigured `anything' for Emacs commands.
2315 It is `anything' replacement of regular `M-x' `execute-extended-command'."
2316 (interactive)
2317 (let* (in-help
2318 help-cand
2319 anything-persistent-action-use-special-display
2320 (history (loop with hist
2321 for i in extended-command-history
2322 for com = (intern i)
2323 when (and (fboundp com) (not (member i hist)))
2324 collect i into hist finally return hist))
2325 (command (anything-comp-read
2326 "M-x " obarray
2327 :test 'commandp
2328 :must-match t
2329 :requires-pattern 2
2330 :name "Emacs Commands"
2331 :persistent-action
2332 #'(lambda (candidate)
2333 (let ((hbuf (get-buffer (help-buffer))))
2334 (if (and in-help (string= candidate help-cand))
2335 (progn
2336 ;; When M-x is started from a help buffer,
2337 ;; Don't kill it as it is anything-current-buffer.
2338 (unless (equal hbuf anything-current-buffer)
2339 (kill-buffer hbuf))
2340 (setq in-help nil))
2341 ;; Be sure anything-current-buffer have not a dedicated window.
2342 (set-window-dedicated-p
2343 (get-buffer-window anything-current-buffer) nil)
2344 (describe-function (intern candidate))
2345 (message nil) ; Erase the new stupid message Type "q"[...]
2346 (setq in-help t))
2347 (setq help-cand candidate)))
2348 :persistent-help "Describe this command"
2349 :history history
2350 :sort 'string-lessp
2351 :fc-transformer 'anything-M-x-transformer)))
2352 (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg))
2353 (call-interactively (intern command))
2354 (setq extended-command-history (cons command (delete command history)))))
2356 ;;;###autoload
2357 (defun anything-manage-advice ()
2358 "Preconfigured `anything' to disable/enable function advices."
2359 (interactive)
2360 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
2362 ;;;###autoload
2363 (defun anything-bookmark-ext ()
2364 "Preconfigured `anything' for bookmark-extensions sources.
2365 Needs bookmark-ext.el:
2366 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
2367 Contain also `anything-c-source-google-suggest'."
2368 (interactive)
2369 (anything
2370 :sources
2371 '(anything-c-source-bookmark-files&dirs
2372 anything-c-source-bookmark-w3m
2373 anything-c-source-google-suggest
2374 anything-c-source-bmkext-addressbook
2375 anything-c-source-bookmark-gnus
2376 anything-c-source-bookmark-info
2377 anything-c-source-bookmark-man
2378 anything-c-source-bookmark-images
2379 anything-c-source-bookmark-su-files&dirs
2380 anything-c-source-bookmark-ssh-files&dirs)
2381 :prompt "SearchBookmark: "
2382 :buffer "*anything bmkext*"))
2384 ;;;###autoload
2385 (defun anything-simple-call-tree ()
2386 "Preconfigured `anything' for simple-call-tree. List function relationships.
2388 Needs simple-call-tree.el.
2389 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
2390 (interactive)
2391 (anything-other-buffer
2392 '(anything-c-source-simple-call-tree-functions-callers
2393 anything-c-source-simple-call-tree-callers-functions)
2394 "*anything simple-call-tree*"))
2396 ;;;###autoload
2397 (defun anything-mark-ring ()
2398 "Preconfigured `anything' for `anything-c-source-mark-ring'."
2399 (interactive)
2400 (anything 'anything-c-source-mark-ring))
2402 ;;;###autoload
2403 (defun anything-global-mark-ring ()
2404 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
2405 (interactive)
2406 (anything 'anything-c-source-global-mark-ring))
2408 ;;;###autoload
2409 (defun anything-all-mark-rings ()
2410 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
2411 `anything-c-source-mark-ring'."
2412 (interactive)
2413 (anything '(anything-c-source-mark-ring
2414 anything-c-source-global-mark-ring)))
2416 ;;;###autoload
2417 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
2418 "Preconfigured `anything' to edit or view EmacsWiki page.
2420 Needs yaoddmuse.el.
2422 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
2423 (interactive)
2424 (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
2426 ;;;###autoload
2427 (defun anything-yaoddmuse-emacswiki-post-library ()
2428 "Preconfigured `anything' to post library to EmacsWiki.
2430 Needs yaoddmuse.el.
2432 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
2433 (interactive)
2434 (anything 'anything-c-source-yaoddmuse-emacswiki-post-library))
2436 ;;;###autoload
2437 (defun anything-eval-expression (arg)
2438 "Preconfigured anything for `anything-c-source-evaluation-result'."
2439 (interactive "P")
2440 (anything :sources 'anything-c-source-evaluation-result
2441 :input (when arg (thing-at-point 'sexp))
2442 :buffer "*anything eval*"
2443 :keymap anything-eval-expression-map))
2445 ;;;###autoload
2446 (defun anything-eval-expression-with-eldoc ()
2447 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
2448 (interactive)
2449 (declare (special eldoc-idle-delay))
2450 (let ((timer (run-with-idle-timer eldoc-idle-delay
2451 'repeat 'anything-eldoc-show-in-eval))
2452 (minibuffer-completing-symbol t) ; Enable lisp completion.
2453 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
2454 (unwind-protect
2455 (minibuffer-with-setup-hook
2456 'anything-eldoc-store-minibuffer
2457 (call-interactively 'anything-eval-expression))
2458 (and timer (cancel-timer timer))
2459 (setq anything-eldoc-active-minibuffers-list
2460 (cdr anything-eldoc-active-minibuffers-list)))))
2462 ;;;###autoload
2463 (defun anything-calcul-expression ()
2464 "Preconfigured anything for `anything-c-source-calculation-result'."
2465 (interactive)
2466 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
2468 ;;;###autoload
2469 (defun anything-surfraw (pattern engine)
2470 "Preconfigured `anything' to search PATTERN with search ENGINE."
2471 (interactive (list (read-string "SearchFor: ")
2472 (anything-comp-read
2473 "Engine: "
2474 (anything-c-build-elvi-list)
2475 :must-match t
2476 :name "Surfraw Search Engines"
2477 :history anything-surfraw-engines-history)))
2478 (let* ((engine-nodesc (car (split-string engine)))
2479 (url (with-temp-buffer
2480 (apply 'call-process "surfraw" nil t nil
2481 ;;JAVE
2482 (append (list engine-nodesc "-p") (split-string pattern)))
2483 (replace-regexp-in-string
2484 "\n" "" (buffer-string))))
2485 (browse-url-browser-function (or anything-surfraw-default-browser-function
2486 browse-url-browser-function)))
2487 (if (string= engine-nodesc "W")
2488 (anything-c-browse-url)
2489 (anything-c-browse-url url)
2490 (setq anything-surfraw-engines-history
2491 (cons engine (delete engine anything-surfraw-engines-history))))))
2493 ;;;###autoload
2494 (defun anything-call-source ()
2495 "Preconfigured `anything' to call anything source."
2496 (interactive)
2497 (anything 'anything-c-source-call-source nil nil nil nil
2498 anything-source-select-buffer))
2500 ;;;###autoload
2501 (defun anything-execute-anything-command ()
2502 "Preconfigured `anything' to execute preconfigured `anything'."
2503 (interactive)
2504 (anything-other-buffer 'anything-c-source-anything-commands
2505 "*anything commands*"))
2507 ;;;###autoload
2508 (defun anything-create (&optional string initial-input)
2509 "Preconfigured `anything' to do many create actions from STRING.
2510 See also `anything-create--actions'."
2511 (interactive)
2512 (setq string (or string (read-string "Create Anything: " initial-input)))
2513 (anything '(((name . "Anything Create")
2514 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
2515 (candidates . anything-create--actions)
2516 (candidate-number-limit)
2517 (action . (lambda (func) (funcall func string)))))))
2519 ;;;###autoload
2520 (defun anything-top ()
2521 "Preconfigured `anything' for top command."
2522 (interactive)
2523 (let ((anything-samewindow t)
2524 (anything-enable-shortcuts)
2525 (anything-display-function 'anything-default-display-buffer)
2526 (anything-candidate-number-limit 9999))
2527 (save-window-excursion
2528 (delete-other-windows)
2529 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
2531 ;;;###autoload
2532 (defun anything-select-xfont ()
2533 "Preconfigured `anything' to select Xfont."
2534 (interactive)
2535 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
2537 ;;;###autoload
2538 (defun anything-world-time ()
2539 "Preconfigured `anything' to show world time."
2540 (interactive)
2541 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
2543 ;;;###autoload
2544 (defun anything-apt (arg query)
2545 "Preconfigured `anything' : frontend of APT package manager.
2546 With a prefix arg reload cache."
2547 (interactive "P\nsSearch Package: ")
2548 (when arg
2549 (setq anything-c-apt-installed-packages nil)
2550 (setq anything-c-apt-all-packages nil))
2551 (anything :sources 'anything-c-source-apt
2552 :prompt "Search Package: " :input query))
2554 ;;;###autoload
2555 (defun anything-esh-pcomplete ()
2556 "Preconfigured anything to provide anything completion in eshell."
2557 (interactive)
2558 (let* ((anything-quit-if-no-candidate t)
2559 (anything-execute-action-at-once-if-one t)
2560 (target (thing-at-point 'symbol))
2561 (end (point))
2562 (beg (or (and target (- end (length target)))
2563 ;; Nothing at point.
2564 (progn (insert " ") (point)))))
2565 (setq anything-ec-target (or target " "))
2566 (with-anything-show-completion beg end
2567 (anything :sources 'anything-c-source-esh
2568 :input (anything-ff-set-pattern ; Handle tramp filenames.
2569 (car (last (ignore-errors ; Needed in lisp symbols completion.
2570 (pcomplete-parse-arguments)))))))))
2572 ;;;###autoload
2573 (defun anything-eshell-history ()
2574 "Preconfigured anything for eshell history."
2575 (interactive)
2576 (let* ((end (point))
2577 (beg (progn (save-excursion (insert " ") (point)))))
2578 (with-anything-show-completion beg end
2579 (anything-other-buffer anything-c-source-eshell-history "*Eshell history*"))))
2581 ;;;###autoload
2582 (defun anything-c-run-external-command (program)
2583 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
2584 If program is already running exit with error.
2585 You can set your own list of commands with
2586 `anything-c-external-commands-list'."
2587 (interactive (list
2588 (anything-comp-read
2589 "RunProgram: "
2590 (anything-c-external-commands-list-1 'sort)
2591 :must-match t
2592 :name "External Commands"
2593 :history anything-external-command-history)))
2594 (anything-run-or-raise program)
2595 (setq anything-external-command-history
2596 (cons program (delete program
2597 (loop for i in anything-external-command-history
2598 when (executable-find i) collect i)))))
2600 ;;;###autoload
2601 (defun anything-ratpoison-commands ()
2602 "Preconfigured `anything' to execute ratpoison commands."
2603 (interactive)
2604 (anything-other-buffer 'anything-c-source-ratpoison-commands
2605 "*anything ratpoison commands*"))
2610 ;;; Utilities Functions
2613 (defun anything-ff-find-printers ()
2614 "Return a list of available printers on Unix systems."
2615 (let ((printer-list (with-temp-buffer
2616 (call-process "lpstat" nil t nil "-a")
2617 (split-string (buffer-string) "\n"))))
2618 (loop for p in printer-list
2619 for printer = (car (split-string p))
2620 when printer
2621 collect printer)))
2623 ;; Shut up byte compiler in emacs24*.
2624 (defun anything-c-switch-to-buffer (buffer-or-name)
2625 "Same as `switch-to-buffer' whithout warnings at compile time."
2626 (with-no-warnings
2627 (switch-to-buffer buffer-or-name)))
2629 (defsubst* anything-c-position (item seq &key (test 'eq))
2630 "A simple and faster replacement of CL `position'."
2631 (loop for i in seq for index from 0
2632 when (funcall test i item) return index))
2634 (defun anything-c-get-pid-from-process-name (process-name)
2635 "Get pid from running process PROCESS-NAME."
2636 (loop with process-list = (list-system-processes)
2637 for pid in process-list
2638 for process = (assoc-default 'comm (process-attributes pid))
2639 when (and process (string-match process-name process))
2640 return pid))
2642 (defun* anything-current-buffer-narrowed-p (&optional
2643 (buffer anything-current-buffer))
2644 "Check if BUFFER is narrowed.
2645 Default is `anything-current-buffer'."
2646 (with-current-buffer buffer
2647 (let ((beg (point-min))
2648 (end (point-max))
2649 (total (buffer-size)))
2650 (or (/= beg 1) (/= end (1+ total))))))
2652 (defun anything-region-active-p ()
2653 (and transient-mark-mode mark-active (/= (mark) (point))))
2655 (defun anything-goto-line (lineno)
2656 "Goto LINENO opening only outline headline if needed."
2657 (goto-char (point-min)) (forward-line (1- lineno))
2658 (when (or (eq major-mode 'org-mode) outline-minor-mode)
2659 (org-reveal))
2660 (anything-match-line-color-current-line) (sit-for 0.3)
2661 (anything-match-line-cleanup))
2663 (defun anything-show-this-source-only ()
2664 "Only show this source."
2665 (interactive)
2666 (setq anything-candidate-number-limit 9999)
2667 (anything-set-source-filter
2668 (list (assoc-default 'name (anything-get-current-source)))))
2670 ;;;###autoload
2671 (defun anything-test-sources ()
2672 "List all anything sources for test.
2673 The output is sexps which are evaluated by \\[eval-last-sexp]."
2674 (interactive)
2675 (with-output-to-temp-buffer "*Anything Test Sources*"
2676 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2677 (apropos-internal "^anything-c-source" #'boundp))
2678 (pop-to-buffer standard-output)))
2680 (defun anything-nest (&rest same-as-anything)
2681 "Nested `anything'. If you use `anything' within `anything', use it."
2682 (with-selected-window (anything-window)
2683 (let (anything-current-position
2684 anything-current-buffer
2685 (orig-anything-buffer anything-buffer)
2686 anything-pattern
2687 anything-buffer
2688 anything-sources
2689 anything-compiled-sources
2690 anything-buffer-chars-modified-tick
2691 (anything-samewindow t)
2692 (enable-recursive-minibuffers t))
2693 (unwind-protect
2694 (apply #'anything same-as-anything)
2695 (anything-initialize-overlays orig-anything-buffer)
2696 (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
2698 (defun anything-displaying-source-names ()
2699 "Display sources name."
2700 (with-current-buffer anything-buffer
2701 (goto-char (point-min))
2702 (loop with pos
2703 while (setq pos (next-single-property-change (point) 'anything-header))
2704 do (goto-char pos)
2705 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2706 do (forward-line 1))))
2708 ;; [Obsolete]
2709 (defun anything-select-source ()
2710 "[OBSOLETE] Select source."
2711 (interactive)
2712 (let ((default (assoc-default 'name (anything-get-current-source)))
2713 (source-names (anything-displaying-source-names))
2714 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2715 (anything-get-sources))))
2716 (setq anything-candidate-number-limit 9999)
2717 (anything-aif
2718 (let (anything-source-filter)
2719 (anything-nest '(((name . "Anything Source")
2720 (candidates . source-names)
2721 (action . identity))
2722 ((name . "Anything Source (ALL)")
2723 (candidates . all-source-names)
2724 (action . identity)))
2725 nil "Source: " nil
2726 default "*anything select source*"))
2727 (anything-set-source-filter (list it))
2728 (anything-set-source-filter nil))))
2730 (defun anything-c-match-on-file-name (candidate)
2731 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2732 (string-match anything-pattern (file-name-nondirectory candidate)))
2734 (defun anything-c-match-on-directory-name (candidate)
2735 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2736 (anything-aif (file-name-directory candidate)
2737 (string-match anything-pattern it)))
2739 (defun anything-c-string-match (candidate)
2740 "Return non-nil if `anything-pattern' match CANDIDATE.
2741 The match is done with `string-match'."
2742 (string-match anything-pattern candidate))
2744 (defun anything-c-skip-entries (list regexp)
2745 "Remove entries which matches REGEXP from LIST."
2746 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2747 list))
2749 (defun anything-c-shadow-entries (list regexp)
2750 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2751 (mapcar (lambda (file)
2752 ;; Add shadow face property to boring files.
2753 (let ((face (if (facep 'file-name-shadow)
2754 'file-name-shadow
2755 ;; fall back to default on XEmacs
2756 'default)))
2757 (if (string-match regexp file)
2758 (setq file (propertize file 'face face))))
2759 file)
2760 list))
2762 (defsubst anything-c-stringify (str-or-sym)
2763 "Get string of STR-OR-SYM."
2764 (if (stringp str-or-sym)
2765 str-or-sym
2766 (symbol-name str-or-sym)))
2768 (defsubst anything-c-symbolify (str-or-sym)
2769 "Get symbol of STR-OR-SYM."
2770 (if (symbolp str-or-sym)
2771 str-or-sym
2772 (intern str-or-sym)))
2774 (defun anything-c-describe-function (func)
2775 "FUNC is symbol or string."
2776 (describe-function (anything-c-symbolify func)))
2778 (defun anything-c-describe-variable (var)
2779 "VAR is symbol or string."
2780 (describe-variable (anything-c-symbolify var)))
2782 (defun anything-c-find-function (func)
2783 "FUNC is symbol or string."
2784 (find-function (anything-c-symbolify func)))
2786 (defun anything-c-find-variable (var)
2787 "VAR is symbol or string."
2788 (find-variable (anything-c-symbolify var)))
2790 (defun anything-c-kill-new (candidate &optional replace)
2791 "CANDIDATE is symbol or string.
2792 See `kill-new' for argument REPLACE."
2793 (kill-new (anything-c-stringify candidate) replace))
2795 (defun* anything-fast-remove-dups (seq &key (test 'eq))
2796 "Remove duplicates elements in list SEQ.
2797 This is same as `remove-duplicates' but with memoisation.
2798 It is much faster, especially in large lists.
2799 A test function can be provided with TEST argument key.
2800 Default is `eq'."
2801 (let ((cont (make-hash-table :test test)))
2802 (loop for elm in seq
2803 unless (gethash elm cont)
2804 do (puthash elm elm cont)
2805 finally return
2806 (loop for i being the hash-values in cont collect i))))
2808 (defadvice eval-defun (after anything-source-hack activate)
2809 "Allow immediate execution of anything source when evaling it.
2810 See `anything-c-enable-eval-defun-hack'."
2811 (when anything-c-enable-eval-defun-hack
2812 (let ((varsym (save-excursion
2813 (beginning-of-defun)
2814 (forward-char 1)
2815 (when (memq (read (current-buffer)) '(defvar setq))
2816 (read (current-buffer))))))
2817 (when (string-match "^anything-c-source-" (symbol-name varsym))
2818 (anything varsym)))))
2819 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2821 (defadvice anything-quit-and-find-file (around use-anything-find-files activate)
2822 "Let `anything-quit-and-find-file' take advantage of `anything-find-files'."
2823 (interactive)
2824 (anything-run-after-quit
2825 (lambda (f)
2826 (if (file-exists-p f)
2827 (anything-find-files-1 (file-name-directory f) f)
2828 (anything-find-files-1 f)))
2829 (anything-aif (get-buffer (anything-get-selection))
2830 (or (buffer-file-name it)
2831 (car (rassoc it dired-buffers))
2832 (and (with-current-buffer it
2833 (eq major-mode 'org-agenda-mode))
2834 org-directory
2835 (expand-file-name org-directory))
2836 default-directory)
2837 (let ((sel (anything-get-selection)))
2838 (if (file-exists-p sel)
2839 (expand-file-name sel)
2840 default-directory)))))
2842 (defmacro* anything-c-walk-directory (directory &key (path 'basename) (directories t) match)
2843 "Walk through DIRECTORY tree.
2844 PATH can be one of basename, relative, or full.
2845 DIRECTORIES when non--nil (default) return also directories names, otherwise
2846 skip directories names.
2847 MATCH match only filenames matching regexp MATCH."
2848 `(let (result
2849 (fn (case ,path
2850 (basename 'file-name-nondirectory)
2851 (relative 'file-relative-name)
2852 (full 'identity)
2853 (t (error "Error: Invalid path spec `%s', must be one of basename, relative or full." ,path)))))
2854 (labels ((ls-R (dir)
2855 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
2856 for f in ls
2857 if (file-directory-p f)
2858 do (progn (when ,directories
2859 (push (funcall fn f) result))
2860 ;; Don't recurse in directory symlink.
2861 (unless (file-symlink-p f)
2862 (ls-R f)))
2863 else do
2864 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
2865 (push (funcall fn f) result)))))
2866 (ls-R ,directory)
2867 (nreverse result))))
2869 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2871 ;;; Anything regexp.
2874 (defun anything-c-query-replace-regexp (candidate)
2875 "Query replace regexp from `anything-regexp'.
2876 With a prefix arg replace only matches surrounded by word boundaries,
2877 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2878 (let ((regexp (funcall (anything-attr 'regexp))))
2879 (apply 'query-replace-regexp
2880 (anything-c-query-replace-args regexp))))
2882 (defun anything-c-kill-regexp-as-sexp (candidate)
2883 "Kill regexp in a format usable in lisp code."
2884 (anything-c-regexp-kill-new
2885 (prin1-to-string (funcall (anything-attr 'regexp)))))
2887 (defun anything-c-kill-regexp (candidate)
2888 "Kill regexp as it is in `anything-pattern'."
2889 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2891 (defun anything-c-query-replace-args (regexp)
2892 "create arguments of `query-replace-regexp' action in `anything-regexp'."
2893 (let ((region-only (anything-region-active-p)))
2894 (list
2895 regexp
2896 (query-replace-read-to regexp
2897 (format "Query replace %sregexp %s"
2898 (if anything-current-prefix-arg "word " "")
2899 (if region-only "in region " ""))
2901 anything-current-prefix-arg
2902 (when region-only (region-beginning))
2903 (when region-only (region-end)))))
2905 (defvar anything-c-source-regexp
2906 '((name . "Regexp Builder")
2907 (init . (lambda ()
2908 (anything-candidate-buffer anything-current-buffer)))
2909 (candidates-in-buffer)
2910 (get-line . anything-c-regexp-get-line)
2911 (persistent-action . anything-c-regexp-persistent-action)
2912 (persistent-help . "Show this line")
2913 (multiline)
2914 (delayed)
2915 (requires-pattern . 2)
2916 (mode-line . "Press TAB to select action.")
2917 (regexp . (lambda () anything-input))
2918 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2919 ("Query Replace Regexp (C-u Not inside word.)"
2920 . anything-c-query-replace-regexp)
2921 ("Kill Regexp" . anything-c-kill-regexp)))))
2923 (defun anything-c-regexp-get-line (s e)
2924 (propertize
2925 (apply 'concat
2926 ;; Line contents
2927 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2928 ;; subexps
2929 (loop for i from 0 to (1- (/ (length (match-data)) 2))
2930 collect (format "\n %s'%s'"
2931 (if (zerop i) "Group 0: " (format "Group %d: " i))
2932 (match-string i))))
2933 ;; match beginning
2934 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2935 ;; It is implementation problem of candidates-in-buffer.
2936 'anything-realvalue
2937 (1- s)))
2939 (defun anything-c-regexp-persistent-action (pt)
2940 (goto-char pt)
2941 (anything-persistent-highlight-point))
2943 (defun anything-c-regexp-kill-new (input)
2944 (kill-new input)
2945 (message "Killed: %s" input))
2949 ;;; Toggle all marks.
2952 ;;;###autoload
2953 (defun anything-mark-all ()
2954 "Mark all visible unmarked candidates in current source."
2955 (interactive)
2956 (with-anything-window
2957 (save-excursion
2958 (goto-char (anything-get-previous-header-pos))
2959 (anything-next-line)
2960 (let* ((next-head (anything-get-next-header-pos))
2961 (end (and next-head
2962 (save-excursion
2963 (goto-char next-head)
2964 (forward-line -1)
2965 (point))))
2966 (maxpoint (or end (point-max))))
2967 (while (< (point) maxpoint)
2968 (anything-mark-current-line)
2969 (let ((prefix (get-text-property (point-at-bol) 'display))
2970 (bn (anything-c-basename (anything-get-selection)))
2971 (src (assoc-default 'name (anything-get-current-source))))
2972 (when (and (not (anything-this-visible-mark))
2973 (not (or (string= prefix "[?]")
2974 (string= prefix "[@]"))))
2975 ;; Don't mark possibles directories ending with . or ..
2976 ;; and also autosave files/links.
2977 (unless
2978 (and (or (anything-file-completion-source-p)
2979 (equal src "Files from Current Directory"))
2980 (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
2981 (anything-make-visible-mark))))
2982 (forward-line 1) (end-of-line))))
2983 (anything-mark-current-line)
2984 (message "%s candidates marked" (length anything-marked-candidates))))
2986 ;;;###autoload
2987 (defun anything-unmark-all ()
2988 "Unmark all candidates in all sources of current anything session."
2989 (interactive)
2990 (with-anything-window
2991 (let ((len (length anything-marked-candidates)))
2992 (save-excursion
2993 (anything-clear-visible-mark))
2994 (setq anything-marked-candidates nil)
2995 (anything-mark-current-line)
2996 (message "%s candidates unmarked" len))))
2998 ;;;###autoload
2999 (defun anything-toggle-all-marks ()
3000 "Toggle all marks.
3001 Mark all visible candidates of current source or unmark all candidates
3002 visible or invisible in all sources of current anything session"
3003 (interactive)
3004 (let ((marked (anything-marked-candidates)))
3005 (if (and (>= (length marked) 1)
3006 (with-anything-window anything-visible-mark-overlays))
3007 (anything-unmark-all)
3008 (anything-mark-all))))
3010 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
3014 ;;; Buffers
3017 (defun anything-c-buffer-list ()
3018 "Return the list of names of buffers with boring buffers filtered out.
3019 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
3020 The first buffer in the list will be the last recently used
3021 buffer that is not the current buffer."
3022 (let ((buffers (mapcar 'buffer-name (buffer-list))))
3023 (append (cdr buffers) (list (car buffers)))))
3025 (defvar anything-c-source-buffers
3026 '((name . "Buffers")
3027 (candidates . anything-c-buffer-list)
3028 (type . buffer)))
3029 ;; (anything 'anything-c-source-buffers)
3031 (defvar anything-c-source-buffer-not-found
3032 '((name . "Create buffer")
3033 (dummy)
3034 (filtered-candidate-transformer (lambda (cands source)
3035 (list anything-pattern)))
3036 (action . (lambda (candidate)
3037 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
3038 ;; (anything 'anything-c-source-buffer-not-found)
3040 ;;; Buffers-list (was buffers+)
3043 (eval-when-compile (require 'dired))
3045 (defun anything-c-highlight-buffers (buffers)
3046 (loop for i in buffers
3047 for buf = (get-buffer i)
3048 for bfname = (buffer-file-name buf)
3049 collect
3050 (cond (;; A dired buffer.
3051 (rassoc buf dired-buffers)
3052 (propertize i 'face 'anything-ff-directory
3053 'help-echo (car (rassoc buf dired-buffers))))
3054 ;; A buffer file modified somewhere outside of emacs.
3055 ((and bfname (not (file-remote-p bfname))
3056 (file-exists-p bfname)
3057 (not (verify-visited-file-modtime buf)))
3058 (propertize i 'face 'anything-buffer-saved-out
3059 'help-echo bfname))
3060 ;; A new buffer file not already saved on disk.
3061 ((and bfname (not (file-remote-p bfname))
3062 (not (verify-visited-file-modtime buf)))
3063 (propertize i 'face 'anything-buffer-not-saved
3064 'help-echo bfname))
3065 ;; A Remote buffer file modified and not saved on disk.
3066 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
3067 (let ((prefix (propertize
3068 " " 'display
3069 (propertize "@ " 'face 'anything-ff-prefix))))
3070 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
3071 'help-echo bfname)) i)))
3072 ;; A buffer file modified and not saved on disk.
3073 ((and bfname (buffer-modified-p buf))
3074 (propertize i 'face 'anything-ff-symlink
3075 'help-echo bfname))
3076 ;; A remote buffer file not modified and saved on disk.
3077 ((and bfname (file-remote-p bfname))
3078 (let ((prefix (propertize
3079 " " 'display
3080 (propertize "@ " 'face 'anything-ff-prefix))))
3081 (cons (concat prefix (propertize i 'face 'font-lock-type-face
3082 'help-echo bfname)) i)))
3083 ;; A buffer file not modified and saved on disk.
3084 (bfname
3085 (propertize i 'face 'font-lock-type-face
3086 'help-echo bfname))
3087 ;; Any non--file buffer.
3088 (t (propertize i 'face 'italic)))))
3091 (defvar anything-c-source-buffers-list
3092 '((name . "Buffers")
3093 (candidates . anything-c-buffer-list)
3094 (type . buffer)
3095 (match anything-c-buffer-match-major-mode)
3096 (diff-action . anything-buffer-toggle-diff)
3097 (revert-action . anything-buffer-revert-and-update)
3098 (save-action . anything-buffer-save-and-update)
3099 (candidate-transformer anything-c-skip-current-buffer
3100 anything-c-skip-boring-buffers
3101 anything-c-highlight-buffers)
3102 (persistent-action . anything-c-buffers-list-persistent-action)
3103 (volatile)
3104 (mode-line . anything-buffer-mode-line-string)
3105 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
3106 ;; (anything 'anything-c-source-buffers-list)
3108 (defun anything-c-buffer-match-major-mode (candidate)
3109 "Match maybe buffer by major-mode.
3110 If you give a major-mode or partial major-mode,
3111 it will list all buffers of this major-mode and/or buffers with name
3112 matching this major-mode.
3113 If you add a space after major-mode and then a space,
3114 it will match all buffers of the major-mode
3115 before space matching pattern after space.
3116 If you give a pattern which doesn't match a major-mode, it will search buffer
3117 with name matching pattern."
3118 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
3119 (buf (get-buffer cand)))
3120 (when buf
3121 (with-current-buffer buf
3122 (let ((mjm (symbol-name major-mode))
3123 (split (split-string anything-pattern)))
3124 (cond ((string-match "\\s-$" anything-pattern)
3125 (string-match (car split) mjm))
3126 ((string-match "\\s-" anything-pattern)
3127 (and (string-match (car split) mjm)
3128 (string-match (cadr split) cand)))
3129 (t (or (string-match anything-pattern mjm)
3130 (string-match anything-pattern cand)))))))))
3132 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
3133 "Query replace in marked buffers.
3134 If REGEXP-FLAG is given use `query-replace-regexp'."
3135 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
3136 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
3137 (bufs (anything-marked-candidates)))
3138 (loop
3139 with replace = (query-replace-read-from prompt regexp-flag)
3140 with tostring = (unless (consp replace)
3141 (query-replace-read-to
3142 replace prompt regexp-flag))
3143 for buf in bufs
3145 (save-window-excursion
3146 (anything-c-switch-to-buffer buf)
3147 (save-excursion
3148 (let ((case-fold-search t))
3149 (goto-char (point-min))
3150 (if (consp replace)
3151 (apply fn (list (car replace) (cdr replace)))
3152 (apply fn (list replace tostring)))))))))
3154 (defun anything-c-buffer-query-replace-regexp (candidate)
3155 (anything-c-buffer-query-replace-1 'regexp))
3157 (defun anything-c-buffer-query-replace (candidate)
3158 (anything-c-buffer-query-replace-1))
3160 (defun anything-buffer-toggle-diff (candidate)
3161 "Toggle diff buffer CANDIDATE with it's file."
3162 (if (get-buffer-window "*Diff*")
3163 (kill-buffer "*Diff*")
3164 (diff-buffer-with-file (get-buffer candidate))))
3166 ;;;###autoload
3167 (defun anything-buffer-diff-persistent ()
3168 "Toggle diff buffer without quitting anything."
3169 (interactive)
3170 (anything-execute-persistent-action 'diff-action))
3172 (defun anything-buffer-revert-and-update (candidate)
3173 (let ((marked (anything-marked-candidates)))
3174 (loop for buf in marked do (anything-revert-buffer buf))
3175 (anything-force-update)
3176 (anything-c-recenter-window)))
3178 ;;;###autoload
3179 (defun anything-buffer-revert-persistent ()
3180 "Revert buffer without quitting anything."
3181 (interactive)
3182 (anything-execute-persistent-action 'revert-action 'onewindow))
3184 (defun anything-buffer-save-and-update (candidate)
3185 (let ((marked (anything-marked-candidates))
3186 (enable-recursive-minibuffers t))
3187 (loop for buf in marked do
3188 (with-current-buffer (get-buffer buf)
3189 (save-buffer)))
3190 (anything-force-update)
3191 (anything-c-recenter-window)))
3193 ;;;###autoload
3194 (defun anything-buffer-save-persistent ()
3195 "Save buffer without quitting anything."
3196 (interactive)
3197 (anything-execute-persistent-action 'save-action 'onewindow))
3199 ;;;###autoload
3200 (defun anything-buffer-run-kill-buffers ()
3201 "Run kill buffer action from `anything-c-source-buffers-list'."
3202 (interactive)
3203 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
3205 ;;;###autoload
3206 (defun anything-buffer-run-grep ()
3207 "Run Grep action from `anything-c-source-buffers-list'."
3208 (interactive)
3209 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
3211 ;;;###autoload
3212 (defun anything-buffer-run-zgrep ()
3213 "Run Grep action from `anything-c-source-buffers-list'."
3214 (interactive)
3215 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
3217 ;;;###autoload
3218 (defun anything-buffer-run-query-replace-regexp ()
3219 "Run Query replace regexp action from `anything-c-source-buffers-list'."
3220 (interactive)
3221 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
3223 ;;;###autoload
3224 (defun anything-buffer-run-query-replace ()
3225 "Run Query replace action from `anything-c-source-buffers-list'."
3226 (interactive)
3227 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
3229 ;;;###autoload
3230 (defun anything-buffer-switch-other-window ()
3231 "Run switch to other window action from `anything-c-source-buffers-list'."
3232 (interactive)
3233 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
3235 ;;;###autoload
3236 (defun anything-buffer-switch-other-frame ()
3237 "Run switch to other frame action from `anything-c-source-buffers-list'."
3238 (interactive)
3239 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
3241 ;;;###autoload
3242 (defun anything-buffer-switch-to-elscreen ()
3243 "Run switch to elscreen action from `anything-c-source-buffers-list'."
3244 (interactive)
3245 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
3247 ;;;###autoload
3248 (defun anything-buffer-run-ediff ()
3249 "Run ediff action from `anything-c-source-buffers-list'."
3250 (interactive)
3251 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers))
3253 (defun anything-buffer-run-ediff-merge ()
3254 "Run ediff action from `anything-c-source-buffers-list'."
3255 (interactive)
3256 (anything-c-quit-and-execute-action 'anything-ediff-marked-buffers-merge))
3258 (defun anything-c-buffers-persistent-kill (buffer)
3259 "Persistent action to kill buffer."
3260 (with-current-buffer (get-buffer buffer)
3261 (if (and (buffer-modified-p)
3262 (buffer-file-name (current-buffer)))
3263 (progn
3264 (save-buffer)
3265 (kill-buffer buffer))
3266 (kill-buffer buffer)))
3267 (anything-delete-current-selection))
3269 (defun anything-c-recenter-window ()
3270 "Make visible current selection by recentering anything window."
3271 (with-anything-window (recenter)))
3273 (defun anything-c-buffers-list-persistent-action (candidate)
3274 (if current-prefix-arg
3275 (anything-c-buffers-persistent-kill candidate)
3276 (anything-c-switch-to-buffer candidate)))
3279 ;;;; <File>
3282 ;;; File name history
3283 (defvar anything-c-source-file-name-history
3284 '((name . "File Name History")
3285 (candidates . file-name-history)
3286 (match anything-c-match-on-file-name
3287 anything-c-match-on-directory-name)
3288 (type . file)))
3289 ;; (anything 'anything-c-source-file-name-history)
3291 ;;; Files in current dir
3294 (defvar anything-c-source-files-in-current-dir
3295 '((name . "Files from Current Directory")
3296 (candidates . (lambda ()
3297 (with-anything-current-buffer
3298 (directory-files (anything-c-current-directory)))))
3299 ;; volatile is not needed, I think.
3300 (type . file)))
3301 ;; (anything 'anything-c-source-files-in-current-dir)
3303 (defun anything-c-highlight-files (files)
3304 (loop for i in files
3305 if (file-directory-p i)
3306 collect (propertize (file-name-nondirectory i)
3307 'face 'anything-ff-directory
3308 'help-echo (expand-file-name i))
3309 else
3310 collect (propertize (file-name-nondirectory i)
3311 'face 'anything-ff-file
3312 'help-echo (expand-file-name i))))
3314 (defvar anything-c-source-files-in-current-dir+
3315 '((name . "Files from Current Directory")
3316 (candidates . (lambda ()
3317 (with-anything-current-buffer
3318 (directory-files (anything-c-current-directory) t))))
3319 (candidate-transformer anything-c-highlight-files)
3320 ;; volatile is not needed, I think.
3321 (type . file)))
3322 ;; (anything 'anything-c-source-files-in-current-dir+)
3326 ;;; Anything-find-files - The anything files browser.
3329 ;; Internal.
3330 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
3331 "*The doc that is inserted in the Name header of a find-files or dired source.")
3332 (defvar anything-ff-auto-update-flag nil
3333 "Internal, flag to turn on/off auto-update in `anything-find-files'.
3334 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
3335 (defvar anything-ff-last-expanded nil
3336 "Store last expanded directory or file.")
3337 (defvar anything-ff-default-directory nil)
3338 (defvar anything-ff-history nil)
3339 (defvar anything-ff-cand-to-mark nil)
3342 (defvar anything-c-source-find-files
3343 `((name . "Find Files")
3344 (header-name . (lambda (name)
3345 (concat name anything-c-find-files-doc-header)))
3346 ;; It is needed for filenames with capital letters
3347 (disable-shortcuts)
3348 (init . (lambda ()
3349 (setq anything-ff-auto-update-flag anything-ff-auto-update-initial-value)))
3350 (candidates . anything-find-files-get-candidates)
3351 (filtered-candidate-transformer anything-c-find-files-transformer)
3352 (image-action1 . anything-ff-rotate-image-left)
3353 (image-action2 . anything-ff-rotate-image-right)
3354 (toggle-basename . anything-ff-toggle-basename)
3355 (properties-action . anything-ff-properties)
3356 (toggle-auto-update . anything-ff-toggle-auto-update)
3357 (kill-buffer-fname . anything-ff-kill-buffer-fname)
3358 (persistent-action . anything-find-files-persistent-action)
3359 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
3360 (mode-line . anything-ff-mode-line-string)
3361 (volatile)
3362 (candidate-number-limit . 9999)
3363 (action-transformer . anything-find-files-action-transformer)
3364 (action
3365 . ,(delq
3367 `(("Find File" . anything-c-find-file-or-marked)
3368 ("Find file in Dired" . anything-c-point-file-in-dired)
3369 ,(and (locate-library "elscreen")
3370 '("Find file in Elscreen" . anything-elscreen-find-file))
3371 ,(and (locate-library "popwin")
3372 '("Find file in popup window" . popwin:find-file))
3373 ("Checksum File" . anything-ff-checksum)
3374 ("Complete at point `M-tab'"
3375 . anything-c-insert-file-name-completion-at-point)
3376 ("Open file externally `C-c C-x, C-u to choose'"
3377 . anything-c-open-file-externally)
3378 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
3379 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
3380 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
3381 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
3382 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
3383 . anything-find-files-eshell-command-on-file)
3384 ("Find file as root" . anything-find-file-as-root)
3385 ("Find file in hex dump" . hexl-find-file)
3386 ("Ediff File `C-='" . anything-find-files-ediff-files)
3387 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
3388 ("Delete File(s) `M-D'" . anything-delete-marked-files)
3389 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
3390 ("Copy file(s) Async" . anything-ff-copy-async)
3391 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
3392 ("Serial rename files" . anything-ff-serial-rename)
3393 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
3394 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
3395 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
3396 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
3397 ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
3398 ("Find file other window `C-o'" . find-file-other-window)
3399 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
3400 ("Find file other frame `C-c C-o'" . find-file-other-frame)
3401 ("Print File `C-c p'" . anything-ff-print)
3402 ("Locate `C-x C-f, C-u to specify locate db'" . anything-ff-locate))))))
3403 ;; (anything 'anything-c-source-find-files)
3405 (defun anything-find-files-set-prompt-for-action (prompt files)
3406 "Set prompt for action in `anything-find-files'."
3407 (let ((len (length files)))
3408 (if (> len 1)
3409 (format "%s * %d Files to: " prompt len)
3410 (format "%s %s to: " prompt (car files)))))
3412 (defun anything-dwim-target-directory ()
3413 "Return value of `default-directory' of buffer in other window.
3414 If there is only one window return the value ot `default-directory'
3415 for current buffer."
3416 (with-anything-current-buffer
3417 (let ((num-windows (length (window-list))))
3418 (if (> num-windows 1)
3419 (save-window-excursion
3420 (other-window 1)
3421 default-directory)
3422 (car anything-ff-history)))))
3424 (defun anything-find-files-do-action (action)
3425 "Generic function for creating action from `anything-c-source-find-files'.
3426 ACTION must be an action supported by `anything-dired-action'."
3427 (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
3428 (anything-marked-candidates)))
3429 (cand (anything-get-selection)) ; Target
3430 (prompt (anything-find-files-set-prompt-for-action
3431 (capitalize (symbol-name action)) ifiles))
3432 (parg anything-current-prefix-arg)
3433 (dest (anything-c-read-file-name
3434 prompt
3435 :preselect (if anything-ff-transformer-show-only-basename
3436 (anything-c-basename cand) cand)
3437 :initial-input (anything-dwim-target-directory)
3438 :history (anything-find-files-history :comp-read nil)))
3439 (win-conf (current-window-configuration)))
3440 (unwind-protect
3441 (let ((default-directory anything-ff-default-directory))
3442 (anything-dired-action
3443 dest :files ifiles :action action :follow parg))
3444 ;; Don't reset win-conf when following.
3445 (unless parg (set-window-configuration win-conf)))))
3447 (defun anything-find-files-copy (candidate)
3448 "Copy files from `anything-find-files'."
3449 (anything-find-files-do-action 'copy))
3451 (defun anything-find-files-rename (candidate)
3452 "Rename files from `anything-find-files'."
3453 (anything-find-files-do-action 'rename))
3455 (defun anything-find-files-symlink (candidate)
3456 "Symlink files from `anything-find-files'."
3457 (anything-find-files-do-action 'symlink))
3459 (defun anything-find-files-relsymlink (candidate)
3460 "Relsymlink files from `anything-find-files'."
3461 (anything-find-files-do-action 'relsymlink))
3463 (defun anything-find-files-hardlink (candidate)
3464 "Hardlink files from `anything-find-files'."
3465 (anything-find-files-do-action 'hardlink))
3467 (defun anything-find-files-byte-compile (candidate)
3468 "Byte compile elisp files from `anything-find-files'."
3469 (let ((files (anything-marked-candidates))
3470 (parg anything-current-prefix-arg))
3471 (loop for fname in files
3472 do (byte-compile-file fname parg))))
3474 (defun anything-find-files-load-files (candidate)
3475 "Load elisp files from `anything-find-files'."
3476 (let ((files (anything-marked-candidates)))
3477 (loop for fname in files
3478 do (load fname))))
3480 (defun anything-find-files-ediff-files (candidate)
3481 "Default action to ediff files in `anything-find-files'."
3482 (ediff-files
3483 candidate
3484 (anything-c-read-file-name
3485 (format "Ediff `%s' With File: " (file-name-nondirectory candidate)))))
3487 (defun anything-find-files-ediff-merge-files (candidate)
3488 "Default action to ediff merge files in `anything-find-files'."
3489 (ediff-merge-files
3490 candidate
3491 (anything-c-read-file-name
3492 (format "Ediff Merge `%s' With File: "
3493 (file-name-nondirectory candidate)))))
3495 (defun anything-find-files-grep (candidate)
3496 "Default action to grep files from `anything-find-files'."
3497 (anything-do-grep-1 (anything-marked-candidates)
3498 anything-current-prefix-arg))
3500 (defun anything-ff-zgrep (candidate)
3501 "Default action to zgrep files from `anything-find-files'."
3502 (let ((prefarg anything-current-prefix-arg)
3503 (ls (anything-marked-candidates)))
3504 (anything-ff-zgrep-1 ls prefarg)))
3506 (defun anything-ff-pdfgrep (candidate)
3507 "Default action to pdfgrep files from `anything-find-files'."
3508 (let ((cands (loop for file in (anything-marked-candidates)
3509 if (or (string= (file-name-extension file) "pdf")
3510 (string= (file-name-extension file) "PDF"))
3511 collect file))
3512 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
3513 (when cands
3514 (anything-do-pdfgrep-1 cands))))
3516 (defun anything-ff-etags-select (candidate)
3517 "Default action to jump to etags from `anything-find-files'."
3518 (when (get-buffer anything-action-buffer)
3519 (kill-buffer anything-action-buffer))
3520 (let ((default-directory anything-ff-default-directory))
3521 (anything-c-etags-select anything-current-prefix-arg)))
3523 (defun anything-find-files-switch-to-hist (candidate)
3524 "Switch to anything-find-files history."
3525 (anything-find-files t))
3527 ;;; Asynchronous copy of files.
3530 (defun anything-c-copy-files-async-1 (flist dest)
3531 "Copy a list of Files FLIST to DEST asynchronously.
3532 It use another emacs process to do the job.
3533 Communication with background emacs is done with temp file
3534 `anything-c-copy-files-async-log-file'."
3535 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
3536 "-Q" "--batch" "--eval"
3537 (format "(progn
3538 (require 'dired) (require 'cl)
3539 (let ((dired-recursive-copies 'always)
3540 failures success
3541 (ovw-count 0)
3542 (cpf-count 0))
3543 (dolist (f '%S)
3544 (condition-case err
3545 (let ((file-exists (file-exists-p
3546 (expand-file-name
3547 (file-name-nondirectory (directory-file-name f))
3548 (file-name-directory
3549 (file-name-as-directory \"%s\"))))))
3550 (dired-copy-file f \"%s\" t)
3551 (if file-exists
3552 (progn (push (cons \"Overwriting\" f) success)
3553 (incf ovw-count))
3554 (push (cons \"Copying\" f) success)
3555 (incf cpf-count)))
3556 (file-error
3557 (push (dired-make-relative
3558 (expand-file-name
3559 (file-name-nondirectory (directory-file-name f))
3560 (file-name-directory \"%s\")))
3561 failures))))
3562 (with-current-buffer (find-file-noselect \"%s\")
3563 (erase-buffer)
3564 (when failures
3565 (dolist (fail (reverse failures))
3566 (insert (concat \"Failed to copy \" fail \"\n\"))))
3567 (when success
3568 (loop for (a . s) in (reverse success) do
3569 (insert (concat a \" \" s \" to %s done\n\"))))
3570 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
3571 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
3572 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
3573 (save-buffer))))"
3574 flist dest dest dest anything-c-copy-files-async-log-file dest)))
3576 (defun anything-c-copy-async-with-log (flist dest)
3577 "Copy file list FLIST to DEST showing log.
3578 Log is send to `anything-c-copy-files-async-log-file'.
3579 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3580 (declare (special auto-revert-interval))
3581 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3582 (set (make-local-variable 'auto-revert-interval) 1)
3583 (erase-buffer)
3584 (insert "Wait copying files...\n")
3585 (sit-for 0.5) (save-buffer)
3586 (goto-char (point-max))
3587 (auto-revert-mode 1)
3588 (anything-c-copy-files-async-1 flist dest))
3590 (defun anything-ff-copy-async (candidate)
3591 "Anything find files action to copy files async.
3592 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3593 (let ((flist (anything-marked-candidates))
3594 (dest (anything-c-read-file-name
3595 "Copy File(s) async To: "
3596 :preselect candidate
3597 :initial-input (car anything-ff-history)
3598 :history (anything-find-files-history :comp-read nil))))
3599 (anything-c-copy-async-with-log flist dest)))
3601 (defvar eshell-command-aliases-list nil)
3602 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3603 "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
3605 Basename of CANDIDATE can be a wild-card.
3606 If MAP is given run `eshell-command' on all marked files at once,
3607 Otherwise, run `eshell-command' on each marked files.
3609 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
3610 `eshell-command-aliases-list' will not be loaded first time you use this."
3611 (when (or eshell-command-aliases-list
3612 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3613 (and eshell-command-aliases-list (eshell-read-aliases-list))
3614 (let* ((cand-list (anything-marked-candidates))
3615 (default-directory (or anything-ff-default-directory
3616 ;; If candidate is an url *-ff-default-directory is nil
3617 ;; so keep value of default-directory.
3618 default-directory))
3619 (command (anything-comp-read
3620 "Command: "
3621 (loop for (a . c) in eshell-command-aliases-list
3622 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3623 collect (propertize a 'help-echo (car c)) into ls
3624 finally return (sort ls 'string<))))
3625 (com-value (car (assoc-default command eshell-command-aliases-list))))
3626 (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
3627 (> (length cand-list) 1))
3628 ;; Run eshell-command with ALL marked files as arguments.
3629 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3630 (eshell-command (format "%s %s" command mapfiles)))
3631 ;; Run eshell-command on EACH marked files.
3632 (loop
3633 for i in cand-list
3634 for bn = (anything-c-basename i)
3635 for files = (if (and bn (string-match "^\*" bn))
3636 ;; Assume if fname is a wildcard
3637 ;; cand-list have a length of 1.
3638 (mapconcat
3639 'shell-quote-argument
3640 (file-expand-wildcards i t) " ")
3641 (format "'%s'" i))
3642 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3643 ;; This allow to enter other args AFTER filename
3644 ;; i.e <command %s some_more_args>
3645 (format command files)
3646 (format "%s %s" command files))
3647 do (eshell-command com))))))
3649 (defun anything-find-files-eshell-command-on-file (candidate)
3650 "Run `eshell-command' on CANDIDATE or marked candidates.
3651 See `anything-find-files-eshell-command-on-file-1' for more info."
3652 (anything-find-files-eshell-command-on-file-1
3653 candidate anything-current-prefix-arg))
3655 (defun anything-ff-switch-to-eshell (candidate)
3656 "Switch to eshell and cd to `anything-ff-default-directory'."
3657 (flet ((cd-eshell ()
3658 (goto-char (point-max))
3659 (insert
3660 (format "cd '%s'" anything-ff-default-directory))
3661 (eshell-send-input)))
3662 (if (get-buffer "*eshell*")
3663 (progn
3664 (anything-c-switch-to-buffer "*eshell*")
3665 (cd-eshell))
3666 (call-interactively 'eshell)
3667 (cd-eshell))))
3669 (defun anything-ff-serial-rename-action (method)
3670 "Rename all marked files to `anything-ff-default-directory' with METHOD.
3671 See `anything-ff-serial-rename-1'."
3672 (let ((cands (anything-marked-candidates))
3673 (name (read-string "NewName: "))
3674 (start (read-number "StartAtNumber: "))
3675 (dir (expand-file-name
3676 (anything-c-read-file-name
3677 "Serial Rename to directory: " :initial-input
3678 (expand-file-name anything-ff-default-directory)))))
3679 (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
3680 (length cands) dir name))
3681 (anything-ff-serial-rename-1 dir cands name start :method method)
3682 (anything-find-files-1 dir))))
3684 (defun anything-ff-member-directory-p (file directory)
3685 (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
3686 (cur-dir (expand-file-name (file-name-as-directory directory))))
3687 (string= dir-file cur-dir)))
3689 (defun* anything-ff-serial-rename-1
3690 (directory collection new-name start-at-num &key (method 'rename))
3691 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3692 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3693 METHOD can be one of rename, copy or symlink.
3694 Files will be renamed if they are files of current directory, otherwise they
3695 will be treated with METHOD.
3696 Default METHOD is rename."
3697 ;; Maybe remove directories selected by error in collection.
3698 (setq collection (remove-if 'file-directory-p collection))
3699 (flet ((symlink-file (file dest)
3700 (let ((flist (list file)))
3701 (anything-dired-action
3702 dest :action 'symlink :files flist))))
3704 (let* ((tmp-dir (file-name-as-directory
3705 (concat (file-name-as-directory directory)
3706 (symbol-name (gensym "tmp")))))
3707 (fn (case method
3708 (copy 'copy-file)
3709 (symlink 'symlink-file)
3710 (rename 'rename-file)
3711 (t (error "Error: Unknow method %s" method)))))
3712 (make-directory tmp-dir)
3713 (loop for i in collection
3714 for count from start-at-num
3715 for fnum = (if (< count 10) "0%s" "%s")
3716 for nname = (concat tmp-dir new-name (format fnum count)
3717 (file-name-extension i 'dot))
3718 do (if (anything-ff-member-directory-p i directory)
3719 (rename-file i nname)
3720 (funcall fn i nname)))
3721 (loop with dirlist = (directory-files
3722 tmp-dir t directory-files-no-dot-files-regexp)
3723 for f in dirlist do
3724 (if (file-symlink-p f)
3725 (symlink-file (file-truename f)
3726 (concat (file-name-as-directory directory)
3727 (anything-c-basename f)))
3728 (rename-file f directory)))
3729 (delete-directory tmp-dir t))))
3731 (defun anything-ff-serial-rename (candidate)
3732 "Serial rename all marked files to `anything-ff-default-directory'.
3733 Rename only file of current directory, and symlink files coming from
3734 other directories.
3735 See `anything-ff-serial-rename-1'."
3736 (anything-ff-serial-rename-action 'rename))
3738 (defun anything-ff-serial-rename-by-symlink (candidate)
3739 "Serial rename all marked files to `anything-ff-default-directory'.
3740 Rename only file of current directory, and symlink files coming from
3741 other directories.
3742 See `anything-ff-serial-rename-1'."
3743 (anything-ff-serial-rename-action 'symlink))
3745 (defun anything-ff-serial-rename-by-copying (candidate)
3746 "Serial rename all marked files to `anything-ff-default-directory'.
3747 Rename only file of current directory, and copy files coming from
3748 other directories.
3749 See `anything-ff-serial-rename-1'."
3750 (anything-ff-serial-rename-action 'copy))
3752 (defun anything-c-quit-and-execute-action (action)
3753 "Quit current anything session and execute ACTION."
3754 (setq anything-saved-action action)
3755 (anything-exit-minibuffer))
3757 (defun anything-ff-toggle-auto-update (candidate)
3758 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3759 (message "[Auto expansion %s]"
3760 (if anything-ff-auto-update-flag "enabled" "disabled")))
3762 ;;;###autoload
3763 (defun anything-ff-run-toggle-auto-update ()
3764 (interactive)
3765 (anything-execute-persistent-action 'toggle-auto-update))
3767 ;;;###autoload
3768 (defun anything-ff-run-switch-to-history ()
3769 "Run Switch to history action from `anything-c-source-find-files'."
3770 (interactive)
3771 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
3773 ;;;###autoload
3774 (defun anything-ff-run-grep ()
3775 "Run Grep action from `anything-c-source-find-files'."
3776 (interactive)
3777 (anything-c-quit-and-execute-action 'anything-find-files-grep))
3779 ;;;###autoload
3780 (defun anything-ff-run-pdfgrep ()
3781 "Run Pdfgrep action from `anything-c-source-find-files'."
3782 (interactive)
3783 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
3785 ;;;###autoload
3786 (defun anything-ff-run-zgrep ()
3787 "Run Grep action from `anything-c-source-find-files'."
3788 (interactive)
3789 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
3791 ;;;###autoload
3792 (defun anything-ff-run-copy-file ()
3793 "Run Copy file action from `anything-c-source-find-files'."
3794 (interactive)
3795 (anything-c-quit-and-execute-action 'anything-find-files-copy))
3797 ;;;###autoload
3798 (defun anything-ff-run-rename-file ()
3799 "Run Rename file action from `anything-c-source-find-files'."
3800 (interactive)
3801 (anything-c-quit-and-execute-action 'anything-find-files-rename))
3803 ;;;###autoload
3804 (defun anything-ff-run-byte-compile-file ()
3805 "Run Byte compile file action from `anything-c-source-find-files'."
3806 (interactive)
3807 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
3809 ;;;###autoload
3810 (defun anything-ff-run-load-file ()
3811 "Run Load file action from `anything-c-source-find-files'."
3812 (interactive)
3813 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
3815 ;;;###autoload
3816 (defun anything-ff-run-eshell-command-on-file ()
3817 "Run eshell command on file action from `anything-c-source-find-files'."
3818 (interactive)
3819 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
3821 ;;;###autoload
3822 (defun anything-ff-run-ediff-file ()
3823 "Run Ediff file action from `anything-c-source-find-files'."
3824 (interactive)
3825 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
3827 ;;;###autoload
3828 (defun anything-ff-run-ediff-merge-file ()
3829 "Run Ediff merge file action from `anything-c-source-find-files'."
3830 (interactive)
3831 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
3833 ;;;###autoload
3834 (defun anything-ff-run-symlink-file ()
3835 "Run Symlink file action from `anything-c-source-find-files'."
3836 (interactive)
3837 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
3839 ;;;###autoload
3840 (defun anything-ff-run-delete-file ()
3841 "Run Delete file action from `anything-c-source-find-files'."
3842 (interactive)
3843 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
3845 ;;;###autoload
3846 (defun anything-ff-run-complete-fn-at-point ()
3847 "Run complete file name action from `anything-c-source-find-files'."
3848 (interactive)
3849 (anything-c-quit-and-execute-action
3850 'anything-c-insert-file-name-completion-at-point))
3852 ;;;###autoload
3853 (defun anything-ff-run-switch-to-eshell ()
3854 "Run switch to eshell action from `anything-c-source-find-files'."
3855 (interactive)
3856 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
3858 ;;;###autoload
3859 (defun anything-ff-run-switch-other-window ()
3860 "Run switch to other window action from `anything-c-source-find-files'."
3861 (interactive)
3862 (anything-c-quit-and-execute-action 'find-file-other-window))
3864 ;;;###autoload
3865 (defun anything-ff-run-switch-other-frame ()
3866 "Run switch to other frame action from `anything-c-source-find-files'."
3867 (interactive)
3868 (anything-c-quit-and-execute-action 'find-file-other-frame))
3870 ;;;###autoload
3871 (defun anything-ff-run-open-file-externally ()
3872 "Run open file externally command action from `anything-c-source-find-files'."
3873 (interactive)
3874 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
3876 (defun anything-ff-locate (candidate)
3877 "Locate action function for `anything-find-files'."
3878 (let ((input (concat (anything-c-basename
3879 (expand-file-name
3880 candidate
3881 anything-ff-default-directory))
3882 ;; The locate '-b' option doesn't exists
3883 ;; in everything.
3884 (unless (and (eq system-type 'windows-nt)
3885 (string-match "^es" anything-c-locate-command))
3886 " -b")))
3887 (anything-mp-highlight-delay 0.7))
3888 (anything-locate-1 anything-current-prefix-arg input)))
3890 ;;;###autoload
3891 (defun anything-ff-run-locate ()
3892 "Run locate action from `anything-c-source-find-files'."
3893 (interactive)
3894 (anything-c-quit-and-execute-action 'anything-ff-locate))
3896 ;;;###autoload
3897 (defun anything-ff-run-gnus-attach-files ()
3898 "Run gnus attach files command action from `anything-c-source-find-files'."
3899 (interactive)
3900 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
3902 ;;;###autoload
3903 (defun anything-ff-run-etags ()
3904 "Run Etags command action from `anything-c-source-find-files'."
3905 (interactive)
3906 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
3909 (defun anything-ff-print (candidate)
3910 "Print marked files.
3911 You have to set in order
3912 variables `lpr-command',`lpr-switches' and/or `printer-name'.
3914 e.g:
3915 \(setq lpr-command \"gtklp\"\)
3916 \(setq lpr-switches '(\"-P\")\)
3917 \(setq printer-name \"Epson-Stylus-Photo-R265\"\)
3919 Same as `dired-do-print' but for anything."
3920 (let* ((file-list (anything-marked-candidates))
3921 (len (length file-list))
3922 (printer-name (if anything-ff-printer-list
3923 (anything-comp-read
3924 "Printer: " anything-ff-printer-list)
3925 printer-name))
3926 (command (read-string
3927 (format "Print *%s File(s):\n%s with: "
3929 (mapconcat
3930 (lambda (f) (format "- %s\n" f))
3931 file-list ""))
3932 (when (and lpr-command
3933 (or lpr-switches
3934 printer-name))
3935 (mapconcat 'identity
3936 (cons lpr-command
3937 (append (if (stringp lpr-switches)
3938 (list lpr-switches)
3939 lpr-switches)
3940 (list printer-name)))
3941 " "))))
3942 (file-args (mapconcat #'(lambda (x)
3943 (format "'%s'" x))
3944 file-list " "))
3945 (cmd-line (concat command " " file-args)))
3946 (if command
3947 (start-process-shell-command "anything-print" nil cmd-line)
3948 (error "Error: Please verify your printer settings in Emacs."))))
3950 ;;;###autoload
3951 (defun anything-ff-run-print-file ()
3952 "Run Print file action from `anything-c-source-find-files'."
3953 (interactive)
3954 (anything-c-quit-and-execute-action 'anything-ff-print))
3956 (defun* anything-ff-checksum (file)
3957 "Calculate the checksum of FILE with completion on algorithms to use.
3958 The checksum is copied to kill-ring."
3959 (let ((algo-list '(md5 sha1 sha224 sha256 sha384 sha512)))
3960 (kill-new
3961 (secure-hash (intern
3962 (anything-comp-read
3963 "Algorithm: " algo-list))
3964 file))
3965 (message "Checksum copied to kill-ring.")))
3967 (defun anything-ff-toggle-basename (candidate)
3968 (setq anything-ff-transformer-show-only-basename
3969 (not anything-ff-transformer-show-only-basename))
3970 (save-excursion
3971 (anything-force-update)))
3973 (defun anything-ff-run-toggle-basename ()
3974 (interactive)
3975 (anything-execute-persistent-action 'toggle-basename))
3977 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3978 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3979 If LEVEL is positive reduce from end else from beginning.
3980 If UNIX-CLOSE is non--nil close filename with /.
3981 If EXPAND is non--nil expand-file-name."
3982 (let* ((exp-fname (expand-file-name fname))
3983 (fname-list (split-string (if (or (string= fname "~/") expand)
3984 exp-fname fname) "/" t))
3985 (len (length fname-list))
3986 (pop-list (if (< level 0)
3987 (subseq fname-list (* level -1))
3988 (subseq fname-list 0 (- len level))))
3989 (result (mapconcat 'identity pop-list "/"))
3990 (empty (string= result "")))
3991 (when unix-close (setq result (concat result "/")))
3992 (if (string-match "^~" result)
3993 (if (string= result "~/") "~/" result)
3994 (if (< level 0)
3995 (if empty "../" (concat "../" result))
3996 (cond ((eq system-type 'windows-nt)
3997 (if empty "c:/" result))
3998 (empty "/")
4000 (concat "/" result)))))))
4002 (defun anything-file-completion-source-p ()
4003 "Test if current source is a dired or find-files source."
4004 (let ((ff-sources '("Find Files" "Copy Files"
4005 "Read File Name History"
4006 "Rename Files" "Symlink Files"
4007 "Hardlink Files" "Write File"
4008 "Insert File" "Read file name"))
4009 (cur-source (cdr (assoc 'name (anything-get-current-source)))))
4010 (loop for i in ff-sources thereis (string= cur-source i))))
4012 (defun anything-find-files-down-one-level (arg)
4013 "Go down one level like unix command `cd ..'.
4014 If prefix numeric arg is given go ARG level down."
4015 (interactive "p")
4016 (with-anything-window
4017 (setq anything-follow-mode nil))
4018 ;; When going to precedent level we want to be at the line
4019 ;; corresponding to actual directory, so store this info
4020 ;; in `anything-ff-last-expanded'.
4021 (if (and (not (file-directory-p anything-pattern))
4022 (file-exists-p anything-pattern))
4023 (setq anything-ff-last-expanded anything-pattern)
4024 (setq anything-ff-last-expanded anything-ff-default-directory))
4025 (when (anything-file-completion-source-p)
4026 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
4027 :unix-close t :expand t)))
4028 (anything-set-pattern new-pattern))))
4030 (defun anything-ff-retrieve-last-expanded ()
4031 "Move overlay to last visited directory `anything-ff-last-expanded'.
4032 This happen after using `anything-find-files-down-one-level',
4033 or hitting C-z on \"..\"."
4034 (when (and anything-ff-last-expanded
4035 (anything-file-completion-source-p))
4036 (let ((dirname (if anything-ff-transformer-show-only-basename
4037 (anything-c-basename
4038 (directory-file-name anything-ff-last-expanded))
4039 (directory-file-name anything-ff-last-expanded))))
4040 (with-anything-window
4041 (when (or (re-search-forward (concat dirname "$") nil t)
4042 (re-search-forward
4043 (concat anything-ff-last-expanded "$") nil t))
4044 (forward-line 0)
4045 (anything-mark-current-line)))
4046 (setq anything-ff-last-expanded nil))))
4047 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
4049 ;; Auto-update - anything-find-files auto expansion of directories.
4051 (defun anything-ff-update-when-only-one-matched ()
4052 "Expand to directory when sole completion.
4053 When only one candidate is remaining and it is a directory,
4054 expand to this directory."
4055 (let ((history-p (string= (assoc-default
4056 'name (anything-get-current-source))
4057 "Read File Name History"))
4058 (completed-p (string= (file-name-as-directory anything-pattern)
4059 anything-ff-default-directory)))
4060 (when (and anything-ff-auto-update-flag
4061 (or (and (anything-file-completion-source-p)
4062 (<= (anything-approximate-candidate-number) 2)
4063 (>= (length (anything-c-basename anything-pattern)) 2))
4064 completed-p)
4065 (not history-p))
4066 (with-anything-window
4067 (and (not completed-p) (anything-next-line))
4068 (let ((cur-cand (anything-get-selection)))
4069 (when (file-directory-p cur-cand)
4070 (if (and (not (string-match "^.*[.]\\{1,2\\}$" cur-cand)) ; [1]
4071 ;; Maybe we are here because completed-p is true
4072 ;; So check this again to be sure.
4073 ;; (this happen only on windows dirs)
4074 (<= (anything-approximate-candidate-number) 2)) ; [2]
4075 ;; If after going to next line the candidate is not "." or ".." [1]
4076 ;; and only one candidate is remaining [2],
4077 ;; assume candidate is a new directory to expand, and do it.
4078 (anything-set-pattern (file-name-as-directory cur-cand))
4079 ;; The candidate is one of "." or ".." (it should be "..").
4080 ;; that mean we have entered the last letter of the directory name
4081 ;; in prompt, so expansion is already done, just add the "/" at end
4082 ;; of name unless anything-pattern ends with "."
4083 (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
4084 (anything-set-pattern (file-name-as-directory anything-pattern))))
4085 (anything-check-minibuffer-input-1)))))))
4086 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
4088 ;; Allow expanding to home directory or root
4089 ;; when entering respectively "~/" or "//" at end of pattern.
4090 ;; e.g /home/thierry/labo/anything-config-qp/~/
4091 ;; will expand to "~/"
4092 ;; and /home/thierry/labo/anything-config-qp//
4093 ;; will expand to "/"
4094 (defun anything-ff-auto-expand-to-home-or-root ()
4095 (when (and (anything-file-completion-source-p)
4096 (string-match ".*\\(/~/\\|/\\{2\\}\\)$" anything-pattern))
4097 (let ((match (match-string 1 anything-pattern)))
4098 (cond ((string= match "//")
4099 (if (eq system-type 'windows-nt)
4100 (setq anything-pattern "c:/")
4101 (setq anything-pattern "/")))
4102 ((string= match "/~/")
4103 (if (eq system-type 'windows-nt)
4104 (setq anything-pattern (file-name-as-directory (getenv "HOME")))
4105 (setq anything-pattern "~/")))))
4106 (setq anything-ff-default-directory anything-pattern)
4107 (with-current-buffer (window-buffer (minibuffer-window))
4108 (delete-minibuffer-contents)
4109 (insert anything-pattern))))
4111 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
4113 (defun anything-c-point-file-in-dired (file)
4114 "Put point on filename FILE in dired buffer."
4115 (dired (file-name-directory file))
4116 (dired-goto-file file))
4118 (defun anything-create-tramp-name (fname)
4119 "Build filename for `anything-pattern' like /su:: or /sudo::."
4120 (apply #'tramp-make-tramp-file-name
4121 (loop with v = (tramp-dissect-file-name fname)
4122 for i across v collect i)))
4124 (defun anything-ff-set-pattern (pattern)
4125 "Handle tramp filenames in `anything-pattern'."
4126 (let ((methods (mapcar 'car tramp-methods))
4127 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
4128 cur-method tramp-name)
4129 (cond ((string= pattern "") "")
4130 ((string-match ".*\\(~//\\|//\\)$" pattern)
4131 (if (eq system-type 'windows-nt) "c:/" "/"))
4132 ((string-match "^~\\|.*/~/$" pattern)
4133 (let* ((home (getenv "HOME"))
4134 (replace (if (eq system-type 'windows-nt)
4135 (replace-regexp-in-string
4136 "\\\\" "/" home)
4137 home)))
4138 (replace-match replace nil t pattern)))
4139 ;; Match "/method:maybe_hostname:"
4140 ((and (string-match reg pattern)
4141 (setq cur-method (match-string 1 pattern))
4142 (member cur-method methods))
4143 (setq tramp-name (anything-create-tramp-name
4144 (match-string 0 pattern)))
4145 (replace-match tramp-name nil t pattern))
4146 ;; Match "/hostname:"
4147 ((and (string-match tramp-file-name-regexp pattern)
4148 (setq cur-method (match-string 1 pattern))
4149 (and cur-method (not (member cur-method methods))))
4150 (setq tramp-name (anything-create-tramp-name
4151 (match-string 0 pattern)))
4152 (replace-match tramp-name nil t pattern))
4153 ;; Match "/method:" in this case don't try to connect.
4154 ((and (not (string-match reg pattern))
4155 (string-match tramp-file-name-regexp pattern)
4156 (member (match-string 1 pattern) methods))
4157 "Invalid tramp file name") ; Write in anything-buffer.
4158 ;; PATTERN is a directory, end it with "/".
4159 ;; This will make PATTERN not ending yet with "/"
4160 ;; candidate for `anything-ff-default-directory',
4161 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
4162 ;; when descending level.
4163 ((file-directory-p pattern)
4164 (file-name-as-directory pattern))
4165 ;; Return PATTERN unchanged.
4166 (t pattern))))
4169 (defun anything-find-files-get-candidates ()
4170 "Create candidate list for `anything-c-source-find-files'."
4171 (let* ((path (anything-ff-set-pattern anything-pattern))
4172 (path-name-dir (if (file-directory-p path)
4173 (file-name-as-directory path)
4174 (file-name-directory path)))
4175 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
4176 (set-text-properties 0 (length path) nil path)
4177 (setq anything-pattern (anything-ff-transform-fname-for-completion path))
4178 (setq anything-ff-default-directory
4179 (if (string= anything-pattern "")
4180 (if (eq system-type 'windows-nt) "c:/" "/")
4181 (unless (string-match ffap-url-regexp path)
4182 path-name-dir)))
4183 (cond ((or (string= path "Invalid tramp file name")
4184 (file-regular-p path)
4185 (and (not (file-exists-p path)) (string-match "/$" path))
4186 (and ffap-url-regexp (string-match ffap-url-regexp path)))
4187 (list path))
4188 ((string= path "") (directory-files "/" t))
4189 ((and (file-directory-p path) (not (file-readable-p path)))
4190 (list (format "Opening directory: access denied, `%s'" path)))
4191 ((file-directory-p path) (directory-files path t))
4193 (append (list path) (directory-files path-name-dir t))))))
4195 (defun anything-ff-transform-fname-for-completion (fname)
4196 "Return FNAME with it's basename modified as a regexp.
4197 e.g foo => f.*o.*o .
4198 If basename contain one or more space or FNAME is a valid directory name
4199 return FNAME unchanged."
4200 (let ((bn (anything-c-basename fname)))
4201 (if (or (not anything-ff-smart-completion)
4202 (string-match "\\s-" bn)
4203 (string-match "/$" fname) ; Allow mkdir.
4204 (file-directory-p fname))
4205 fname ; Fall back to match-plugin.
4206 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
4207 (mapconcat 'identity (split-string bn "" t) ".*") bn))
4208 (concat (file-name-directory fname) bn))))
4210 (defun anything-ff-save-history ()
4211 "Store the last value of `anything-ff-default-directory' \
4212 in `anything-ff-history'."
4213 (when (and anything-ff-default-directory
4214 (anything-file-completion-source-p))
4215 (push anything-ff-default-directory anything-ff-history)))
4216 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
4218 (defun anything-ff-valid-symlink-p (file)
4219 (file-exists-p (file-truename file)))
4221 (defun anything-ff-properties (candidate)
4222 "Show file properties of CANDIDATE in a tooltip or message."
4223 (let ((type (anything-ff-attributes candidate :type t))
4224 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
4225 (if (window-system)
4226 (tooltip-show
4227 (concat
4228 (anything-c-basename candidate) ": \n"
4229 "Type: " type "\n"
4230 (when (string= type "symlink")
4231 (format "True name: '%s'\n"
4232 (cond ((string-match "^\.#" (anything-c-basename candidate))
4233 "Autosave symlink")
4234 ((anything-ff-valid-symlink-p candidate)
4235 (file-truename candidate))
4236 (t "Invalid Symlink"))))
4237 dired-line))
4238 (message dired-line) (sit-for 5))))
4240 ;;;###autoload
4241 (defun anything-ff-properties-persistent ()
4242 "Show properties without quitting anything."
4243 (interactive)
4244 (anything-execute-persistent-action 'properties-action))
4246 (defun anything-ff-kill-buffer-fname (candidate)
4247 (let* ((buf (get-file-buffer candidate))
4248 (buf-name (buffer-name buf)))
4249 (if buf
4250 (progn
4251 (kill-buffer buf) (message "Buffer `%s' killed" buf))
4252 (message "No buffer to kill"))))
4254 (defun anything-ff-kill-or-find-buffer-fname (candidate)
4255 "Find file CANDIDATE or kill it's buffer if it is visible.
4256 Never kill `anything-current-buffer'.
4257 Never kill buffer modified.
4258 This is called normally on third hit of \
4259 \\<anything-map>\\[anything-execute-persistent-action]
4260 in `anything-find-files-persistent-action'."
4261 (let* ((buf (get-file-buffer candidate))
4262 (buf-name (buffer-name buf)))
4263 (if (and buf (get-buffer-window buf)
4264 (not (eq buf (get-buffer anything-current-buffer)))
4265 (not (buffer-modified-p buf)))
4266 (progn
4267 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
4268 (find-file candidate))))
4270 ;;;###autoload
4271 (defun anything-ff-run-kill-buffer-persistent ()
4272 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
4273 (interactive)
4274 (anything-execute-persistent-action 'kill-buffer-fname))
4276 (defun anything-ff-human-size (size)
4277 "Return a string showing SIZE of a file in human readable form.
4278 SIZE can be an integer or a float depending it's value.
4279 `file-attributes' will take care of that to avoid overflow error.
4280 KBSIZE if a floating point number, default value is 1024.0."
4281 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
4282 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
4283 (K (cons "K" (/ size anything-ff-default-kbsize)))
4284 (B (cons "B" size)))
4285 (loop with result = B
4286 for (a . b) in
4287 (loop for (x . y) in (list M G K B)
4288 unless (< y 1) collect (cons x y))
4289 when (< b (cdr result)) do (setq result (cons a b))
4290 finally return (if (string= (car result) "B")
4291 (format "%s" size)
4292 (format "%.1f%s" (cdr result) (car result))))))
4294 (defun* anything-ff-attributes
4295 (file &key type links uid gid access-time modif-time
4296 status size mode gid-change inode device-num dired human-size)
4297 "Easy interface for `file-attributes'."
4298 (let ((all (destructuring-bind
4299 (type links uid gid access-time modif-time
4300 status size mode gid-change inode device-num)
4301 (file-attributes file 'string)
4302 (list :type type
4303 :links links
4304 :uid uid
4305 :gid gid
4306 :access-time access-time
4307 :modif-time modif-time
4308 :status status
4309 :size size
4310 :mode mode
4311 :gid-change gid-change
4312 :inode inode
4313 :device-num device-num))))
4314 (cond (type
4315 (let ((result (getf all :type)))
4316 (cond ((stringp result)
4317 "symlink")
4318 (result "directory")
4319 (t "file"))))
4320 (links (getf all :links))
4321 (uid (getf all :uid))
4322 (gid (getf all :gid))
4323 (access-time
4324 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
4325 (modif-time
4326 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
4327 (status
4328 (format-time-string "%Y-%m-%d %R" (getf all :status)))
4329 (size (if human-size (anything-ff-human-size (getf all :size))
4330 (getf all :size)))
4331 (mode (getf all :mode))
4332 (gid-change (getf all :gid-change))
4333 (inode (getf all :inode))
4334 (device-num (getf all :device-num))
4335 (dired
4336 (concat
4337 (getf all :mode) " "
4338 (number-to-string (getf all :links)) " "
4339 (getf all :uid) ":"
4340 (getf all :gid) " "
4341 (if human-size (anything-ff-human-size (getf all :size))
4342 (int-to-string (getf all :size))) " "
4343 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
4344 (t all))))
4346 (defun anything-ff-prefix-filename (fname &optional file-or-symlinkp new-file)
4347 "Return filename FNAME maybe prefixed with [?] or [@].
4348 If FILE-OR-SYMLINKP is non--nil this mean we assume FNAME is an
4349 existing filename or valid symlink and there is no need to test it.
4350 NEW-FILE when non--nil mean FNAME is a non existing file and
4351 return FNAME prefixed with [?]."
4352 (let* ((prefix-new (propertize
4353 " " 'display
4354 (propertize "[?]" 'face 'anything-ff-prefix)))
4355 (prefix-url (propertize
4356 " " 'display
4357 (propertize "[@]" 'face 'anything-ff-prefix))))
4358 (cond ((or file-or-symlinkp (file-exists-p fname)) fname)
4359 ((string-match ffap-url-regexp fname)
4360 (concat prefix-url " " fname))
4361 ((or new-file (not (file-exists-p fname)))
4362 (concat prefix-new " " fname)))))
4364 (defun anything-c-find-files-transformer (files sources)
4365 "Transformer for `anything-c-source-find-files'.
4366 Tramp files are not highlighted unless `anything-ff-tramp-not-fancy'
4367 is non--nil."
4368 (if (and (string-match tramp-file-name-regexp anything-pattern)
4369 anything-ff-tramp-not-fancy)
4370 (if anything-ff-transformer-show-only-basename
4371 (loop for i in files collect
4372 (if (string-match "[.]\\{1,2\\}$" i)
4373 i (cons (anything-c-basename i) i)))
4374 files)
4375 (anything-ff-highlight-files files sources)))
4377 (defvar anything-ff-transformer-show-only-basename nil)
4378 (defun anything-ff-highlight-files (files sources)
4379 "Candidate transformer for `anything-c-source-find-files' without icons."
4380 (loop for i in files
4381 for disp = (if (and anything-ff-transformer-show-only-basename
4382 (not (string-match "[.]\\{1,2\\}$" i))
4383 (not (string-match ffap-url-regexp i)))
4384 (anything-c-basename i) i)
4385 collect
4386 (cond ((and (stringp (car (file-attributes i)))
4387 (not (anything-ff-valid-symlink-p i))
4388 (not (string-match "^\.#" (anything-c-basename i))))
4389 (cons (anything-ff-prefix-filename
4390 (propertize disp 'face 'anything-ff-invalid-symlink) t)
4392 ((stringp (car (file-attributes i)))
4393 (cons (anything-ff-prefix-filename
4394 (propertize disp 'face 'anything-ff-symlink) t)
4396 ((eq t (car (file-attributes i)))
4397 (cons (anything-ff-prefix-filename
4398 (propertize disp 'face 'anything-ff-directory) t)
4400 ((file-executable-p i)
4401 (cons (anything-ff-prefix-filename
4402 (propertize disp 'face 'anything-ff-executable) t)
4404 ((file-exists-p i)
4405 (cons (anything-ff-prefix-filename
4406 (propertize disp 'face 'anything-ff-file) t)
4409 (cons (anything-ff-prefix-filename
4410 (propertize disp 'face 'anything-ff-file) nil 'new-file)
4411 i)))))
4413 (defun anything-find-files-action-transformer (actions candidate)
4414 "Action transformer for `anything-c-source-find-files'."
4415 (cond ((with-anything-current-buffer
4416 (eq major-mode 'message-mode))
4417 (append (subseq actions 0 4)
4418 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
4419 (subseq actions 4)))
4420 ((string-match (image-file-name-regexp) candidate)
4421 (append (subseq actions 0 4)
4422 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
4423 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
4424 (subseq actions 4)))
4425 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
4426 (car it) candidate))
4427 (append (subseq actions 0 4)
4428 '(("Byte compile lisp file(s) `M-B, C-u to load'"
4429 . anything-find-files-byte-compile)
4430 ("Load File(s) `M-L'" . anything-find-files-load-files))
4431 (subseq actions 4)))
4432 ((and (string-match "\.html?$" candidate)
4433 (file-exists-p candidate))
4434 (append (subseq actions 0 4)
4435 '(("Browse url file" . browse-url-of-file))
4436 (subseq actions 5)))
4437 ((or (string= (file-name-extension candidate) "pdf")
4438 (string= (file-name-extension candidate) "PDF"))
4439 (append (subseq actions 0 4)
4440 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
4441 (subseq actions 5)))
4442 (t actions)))
4444 (defun anything-ff-gnus-attach-files (candidate)
4445 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
4446 (let ((flist (anything-marked-candidates)))
4447 (gnus-dired-attach flist)))
4449 (defun anything-ff-rotate-current-image-1 (file &optional num-arg)
4450 "Rotate current image at NUM-ARG degrees.
4451 This is a destructive operation on FILE made by external tool mogrify."
4452 (declare (special image-dired-display-image-buffer))
4453 (setq file (file-truename file)) ; For symlinked images.
4454 ;; When FILE is not an image-file, do nothing.
4455 (when (string-match (image-file-name-regexp) file)
4456 (if (executable-find "mogrify")
4457 (progn
4458 (shell-command (format "mogrify -rotate %s %s"
4459 (or num-arg 90)
4460 (shell-quote-argument file)))
4461 (when (buffer-live-p image-dired-display-image-buffer)
4462 (kill-buffer image-dired-display-image-buffer))
4463 (image-dired-display-image file)
4464 (message nil)
4465 (display-buffer (get-buffer image-dired-display-image-buffer)))
4466 (error "mogrify not found"))))
4468 (defun anything-ff-rotate-image-left (candidate)
4469 "Rotate image file CANDIDATE left.
4470 This affect directly file CANDIDATE."
4471 (anything-ff-rotate-current-image-1 candidate -90))
4473 (defun anything-ff-rotate-image-right (candidate)
4474 "Rotate image file CANDIDATE right.
4475 This affect directly file CANDIDATE."
4476 (anything-ff-rotate-current-image-1 candidate))
4478 (defun anything-ff-rotate-left-persistent ()
4479 "Rotate image left without quitting anything."
4480 (interactive)
4481 (anything-execute-persistent-action 'image-action1))
4483 (defun anything-ff-rotate-right-persistent ()
4484 "Rotate image right without quitting anything."
4485 (interactive)
4486 (anything-execute-persistent-action 'image-action2))
4488 (defun anything-ff-exif-data (candidate)
4489 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
4490 (if (and anything-ff-exif-data-program
4491 (executable-find anything-ff-exif-data-program))
4492 (shell-command-to-string (format "%s %s %s"
4493 anything-ff-exif-data-program
4494 anything-ff-exif-data-program-args
4495 candidate))
4496 (format "No program %s found to extract exif"
4497 anything-ff-exif-data-program)))
4499 (defun anything-find-files-persistent-action (candidate)
4500 "Open subtree CANDIDATE without quitting anything.
4501 If CANDIDATE is not a directory expand CANDIDATE filename.
4502 If CANDIDATE is alone, open file CANDIDATE filename.
4503 That's mean:
4504 First hit on C-z expand CANDIDATE second hit open file.
4505 If a prefix arg is given or `anything-follow-mode' is on open file."
4506 (let ((follow (buffer-local-value
4507 'anything-follow-mode
4508 (get-buffer-create anything-buffer)))
4509 (new-pattern (anything-get-selection))
4510 (num-lines-buf (with-current-buffer anything-buffer
4511 (count-lines (point-min) (point-max)))))
4512 (flet ((insert-in-minibuffer (fname)
4513 (with-selected-window (minibuffer-window)
4514 (unless follow
4515 (delete-minibuffer-contents)
4516 (set-text-properties 0 (length fname) nil fname)
4517 (insert fname)))))
4518 (cond (;; A symlink directory, expand it's truename.
4519 (and (file-directory-p candidate) (file-symlink-p candidate))
4520 (insert-in-minibuffer (file-name-as-directory
4521 (file-truename
4522 (expand-file-name candidate)))))
4523 ;; A directory, open it.
4524 ((file-directory-p candidate)
4525 (when (string= (anything-c-basename candidate) "..")
4526 (setq anything-ff-last-expanded anything-ff-default-directory))
4527 (insert-in-minibuffer (file-name-as-directory
4528 (expand-file-name candidate))))
4529 ;; A symlink file, expand to it's true name. (first hit)
4530 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
4531 (insert-in-minibuffer (file-truename candidate)))
4532 ;; A regular file, expand it, (first hit)
4533 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
4534 (insert-in-minibuffer new-pattern))
4535 ;; An image file and it is the second hit on C-z,
4536 ;; show the file in `image-dired'.
4537 ((string-match (image-file-name-regexp) candidate)
4538 (when (buffer-live-p image-dired-display-image-buffer)
4539 (kill-buffer image-dired-display-image-buffer))
4540 (image-dired-display-image candidate)
4541 (message nil)
4542 (anything-c-switch-to-buffer image-dired-display-image-buffer)
4543 (with-current-buffer image-dired-display-image-buffer
4544 (let ((exif-data (anything-ff-exif-data candidate)))
4545 (image-dired-update-property 'help-echo exif-data))))
4546 ;; Allow browsing archive on avfs fs.
4547 ;; Assume volume is already mounted with mountavfs.
4548 ((and anything-ff-avfs-directory
4549 (string-match
4550 (regexp-quote (expand-file-name anything-ff-avfs-directory))
4551 (file-name-directory candidate))
4552 (anything-ff-file-compressed-p candidate))
4553 (insert-in-minibuffer (concat candidate "#")))
4554 ;; On second hit we open file.
4555 ;; On Third hit we kill it's buffer maybe.
4557 (anything-ff-kill-or-find-buffer-fname candidate))))))
4559 (defun anything-ff-file-compressed-p (candidate)
4560 "Whether CANDIDATE is a compressed file or not."
4561 (member (file-name-extension candidate)
4562 anything-ff-file-compressed-list))
4564 (defun anything-c-insert-file-name-completion-at-point (candidate)
4565 "Insert file name completion at point."
4566 (with-anything-current-buffer
4567 (if buffer-read-only
4568 (error "Error: Buffer `%s' is read-only" (buffer-name))
4569 (let* ((end (point))
4570 (guess (substring-no-properties (thing-at-point 'filename)))
4571 (beg (- (point) (length guess)))
4572 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
4573 (string-match-p "^[^\~]" guess))))
4574 (set-text-properties 0 (length candidate) nil candidate)
4575 (if (and guess (not (string= guess ""))
4576 (string-match-p "^~\\|/.*" guess))
4577 (progn
4578 (delete-region beg end)
4579 (insert (if full-path-p
4580 (expand-file-name candidate)
4581 (abbreviate-file-name candidate))))
4582 (error "Aborting completion: No valid file name at point"))))))
4584 (defun* anything-find-files-history (&key (comp-read t))
4585 "The `anything-find-files' history.
4586 Show the first `anything-ff-history-max-length' elements of `anything-ff-history'
4587 in an `anything-comp-read'."
4588 (let ((history (when anything-ff-history
4589 (loop with dup for i in anything-ff-history
4590 ;; Remove duplicate and not existing files.
4591 ;; Keep remote files.
4592 unless (or (member i dup)
4593 (and (not (file-remote-p i))
4594 (not (file-exists-p i))))
4595 collect i into dup
4596 finally return dup)))) ; Remove dups.
4597 (when history
4598 (setq anything-ff-history
4599 (if (>= (length history) anything-ff-history-max-length)
4600 (subseq history 0 anything-ff-history-max-length)
4601 history))
4602 (if comp-read
4603 (anything-comp-read
4604 "Switch to Directory: "
4605 anything-ff-history
4606 :name "Anything Find Files History"
4607 :must-match t)
4608 anything-ff-history))))
4610 (defun anything-find-files-1 (fname &optional preselect)
4611 "Find FNAME with `anything' completion.
4612 Like `find-file' but with `anything' support.
4613 Use it for non--interactive calls of `anything-find-files'."
4614 (when (get-buffer anything-action-buffer)
4615 (kill-buffer anything-action-buffer))
4616 (let ((anything-mp-highlight-delay nil)
4617 anything-samewindow)
4618 (anything :sources 'anything-c-source-find-files
4619 :input fname
4620 :preselect preselect
4621 :keymap anything-find-files-map
4622 :prompt "Find Files or Url: "
4623 :buffer "*Anything Find Files*")))
4626 (defun anything-find-files-initial-input (&optional input)
4627 "Return INPUT if present, otherwise try to guess it."
4628 (or (and input (expand-file-name input))
4629 (anything-find-files-input
4630 (ffap-guesser)
4631 (thing-at-point 'filename))))
4633 (defun anything-find-files-input (fap tap)
4634 "Default input of `anything-find-files'."
4635 (let* ((def-dir (anything-c-current-directory))
4636 (lib (anything-find-library-at-point))
4637 (url (anything-ff-find-url-at-point))
4638 (file-p (and fap (not (string= fap ""))
4639 (file-exists-p fap)
4640 tap (not (string= tap ""))
4641 (file-exists-p
4642 (file-name-directory (expand-file-name tap def-dir))))))
4643 (cond (lib) ; e.g we are inside a require sexp.
4644 (url) ; String at point is an hyperlink.
4645 (file-p (expand-file-name tap def-dir))
4646 (t (and (not (string= fap "")) fap)))))
4648 (defun anything-c-current-directory ()
4649 "Return current-directory name at point.
4650 Useful in dired buffers when there is inserted subdirs."
4651 (if (eq major-mode 'dired-mode)
4652 (dired-current-directory)
4653 default-directory))
4655 (defun anything-ff-find-url-at-point ()
4656 "Try to find link to an url in text-property at point."
4657 (let* ((he (get-text-property (point) 'help-echo))
4658 (ov (overlays-at (point)))
4659 (ov-he (and ov (overlay-get
4660 (car (overlays-at (point))) 'help-echo)))
4661 (w3m-l (get-text-property (point) 'w3m-href-anchor))
4662 (nt-prop (get-text-property (point) 'nt-link)))
4663 ;; Org link.
4664 (when (and (stringp he) (string-match "^LINK: " he))
4665 (setq he (replace-match "" t t he)))
4666 (loop for i in (list he ov-he w3m-l nt-prop)
4667 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4669 (defun anything-find-library-at-point ()
4670 "Try to find library path at point.
4671 Find inside `require' and `declare-function' sexp."
4672 (require 'find-func)
4673 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4674 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4675 (sexp (and beg-sexp end-sexp
4676 (buffer-substring-no-properties
4677 (1+ beg-sexp) (1- end-sexp)))))
4678 (ignore-errors
4679 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4680 (find-library-name
4681 (replace-regexp-in-string
4682 "'\\|\)\\|\(" ""
4683 ;; If require use third arg, ignore it,
4684 ;; always use library path found in `load-path'.
4685 (second (split-string (match-string 0 sexp))))))
4686 ((and sexp (string-match-p "^declare-function" sexp))
4687 (find-library-name
4688 (replace-regexp-in-string
4689 "\"\\|ext:" ""
4690 (third (split-string sexp)))))
4691 (t nil)))))
4693 ;;; Anything completion for `write-file'.==> C-x C-w
4694 (defvar anything-c-source-write-file
4695 `((name . "Write File")
4696 (header-name . (lambda (name)
4697 (concat name anything-c-find-files-doc-header)))
4698 ;; It is needed for filenames with capital letters
4699 (disable-shortcuts)
4700 (candidates . anything-find-files-get-candidates)
4701 (filtered-candidate-transformer anything-c-find-files-transformer)
4702 (persistent-action . anything-find-files-persistent-action)
4703 (persistent-help . "Expand Candidate")
4704 (volatile)
4705 (action .
4706 (("Write File" . (lambda (candidate)
4707 (write-file candidate 'confirm)))))))
4709 ;;; Anything completion for `insert-file'.==> C-x i
4710 (defvar anything-c-source-insert-file
4711 `((name . "Insert File")
4712 (header-name . (lambda (name)
4713 (concat name anything-c-find-files-doc-header)))
4714 ;; It is needed for filenames with capital letters
4715 (disable-shortcuts)
4716 (candidates . anything-find-files-get-candidates)
4717 (filtered-candidate-transformer anything-c-find-files-transformer)
4718 (persistent-action . anything-find-files-persistent-action)
4719 (persistent-help . "Expand Candidate")
4720 (volatile)
4721 (action .
4722 (("Insert File" . (lambda (candidate)
4723 (when (y-or-n-p (format "Really insert %s in %s "
4724 candidate anything-current-buffer))
4725 (insert-file-contents candidate))))))))
4727 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4728 (defvar anything-c-source-copy-files
4729 `((name . "Copy Files")
4730 (header-name . (lambda (name)
4731 (concat name anything-c-find-files-doc-header)))
4732 ;; It is needed for filenames with capital letters
4733 (disable-shortcuts)
4734 (candidates . anything-find-files-get-candidates)
4735 (filtered-candidate-transformer anything-c-find-files-transformer)
4736 (persistent-action . anything-find-files-persistent-action)
4737 (persistent-help . "Expand Candidate")
4738 (volatile)
4739 (action .
4740 (("Copy File"
4741 . (lambda (candidate)
4742 (anything-dired-action candidate :action 'copy)))
4743 ("Copy and Follow"
4744 . (lambda (candidate)
4745 (anything-dired-action candidate :action 'copy :follow t)))))))
4748 (defvar anything-c-source-rename-files
4749 `((name . "Rename Files")
4750 (header-name . (lambda (name)
4751 (concat name anything-c-find-files-doc-header)))
4752 ;; It is needed for filenames with capital letters
4753 (disable-shortcuts)
4754 (candidates . anything-find-files-get-candidates)
4755 (filtered-candidate-transformer anything-c-find-files-transformer)
4756 (persistent-action . anything-find-files-persistent-action)
4757 (persistent-help . "Expand Candidate")
4758 (volatile)
4759 (action .
4760 (("Rename File"
4761 . (lambda (candidate)
4762 (anything-dired-action candidate :action 'rename)))
4763 ("Rename and Follow"
4764 . (lambda (candidate)
4765 (anything-dired-action candidate :action 'rename :follow t)))))))
4767 (defvar anything-c-source-symlink-files
4768 `((name . "Symlink Files")
4769 (header-name . (lambda (name)
4770 (concat name anything-c-find-files-doc-header)))
4771 ;; It is needed for filenames with capital letters
4772 (disable-shortcuts)
4773 (candidates . anything-find-files-get-candidates)
4774 (filtered-candidate-transformer anything-c-find-files-transformer)
4775 (persistent-action . anything-find-files-persistent-action)
4776 (persistent-help . "Expand Candidate")
4777 (volatile)
4778 (action
4779 . (("Symlink File"
4780 . (lambda (candidate)
4781 (anything-dired-action candidate :action 'symlink)))
4782 ("RelSymlink File"
4783 . (lambda (candidate)
4784 (anything-dired-action candidate :action 'relsymlink)))))))
4787 (defvar anything-c-source-hardlink-files
4788 `((name . "Hardlink Files")
4789 (header-name . (lambda (name)
4790 (concat name anything-c-find-files-doc-header)))
4791 ;; It is needed for filenames with capital letters
4792 (disable-shortcuts)
4793 (candidates . anything-find-files-get-candidates)
4794 (filtered-candidate-transformer anything-c-find-files-transformer)
4795 (persistent-action . anything-find-files-persistent-action)
4796 (persistent-help . "Expand Candidate")
4797 (volatile)
4798 (action
4799 . (("Hardlink File"
4800 . (lambda (candidate)
4801 (anything-dired-action candidate :action 'hardlink)))))))
4803 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4804 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4805 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4806 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4807 (let ((fn (case action
4808 ('copy 'dired-copy-file)
4809 ('rename 'dired-rename-file)
4810 ('symlink 'make-symbolic-link)
4811 ('relsymlink 'dired-make-relative-symlink)
4812 ('hardlink 'dired-hardlink)))
4813 (marker (case action
4814 ((copy rename) dired-keep-marker-copy)
4815 ('symlink dired-keep-marker-symlink)
4816 ('relsymlink dired-keep-marker-relsymlink)
4817 ('hardlink dired-keep-marker-hardlink)))
4818 (dirflag (and (= (length files) 1)
4819 (file-directory-p (car files))
4820 (not (file-directory-p candidate)))))
4821 (dired-create-files
4822 fn (symbol-name action) files
4823 ;; CANDIDATE is the destination.
4824 (if (file-directory-p candidate)
4825 ;; When CANDIDATE is a directory, build file-name in this directory.
4826 ;; Else we use CANDIDATE.
4827 #'(lambda (from)
4828 (expand-file-name (file-name-nondirectory from) candidate))
4829 #'(lambda (from) candidate))
4830 marker)
4831 (when (and follow (not (get-buffer dired-log-buffer)))
4832 (let ((target (directory-file-name candidate)))
4833 (unwind-protect
4834 (progn
4835 (setq anything-ff-cand-to-mark
4836 (anything-get-dest-fnames-from-list files candidate dirflag))
4837 (if (and dirflag (eq action 'rename))
4838 (anything-find-files-1 (file-name-directory target)
4839 (if anything-ff-transformer-show-only-basename
4840 (anything-c-basename target) target))
4841 (anything-find-files-1 (expand-file-name candidate))))
4842 (setq anything-ff-cand-to-mark nil))))))
4845 (defun anything-c-basename (fname)
4846 "Resolve basename of file or directory named FNAME."
4847 (file-name-nondirectory (directory-file-name fname)))
4849 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4850 "Transform filenames of FLIST to abs of DEST-CAND.
4851 If RENAME-DIR-FLAG is non--nil collect the `directory-file-name' of transformed
4852 members of FLIST."
4853 ;; At this point files have been renamed/copied at destination.
4854 ;; That's mean DEST-CAND exists.
4855 (loop
4856 with dest = (expand-file-name dest-cand)
4857 for src in flist
4858 for basename-src = (anything-c-basename src)
4859 for fname = (cond (rename-dir-flag (directory-file-name dest))
4860 ((file-directory-p dest)
4861 (concat (file-name-as-directory dest) basename-src))
4862 (t dest))
4863 when (file-exists-p fname)
4864 collect fname into tmp-list
4865 finally return (sort tmp-list 'string<)))
4867 (defun anything-ff-maybe-mark-candidates ()
4868 "Mark all candidates of list `anything-ff-cand-to-mark'."
4869 (when (and (string= (assoc-default 'name (anything-get-current-source))
4870 (assoc-default 'name anything-c-source-find-files))
4871 anything-ff-cand-to-mark)
4872 (with-anything-window
4873 (while anything-ff-cand-to-mark
4874 (if (string= (car anything-ff-cand-to-mark) (anything-get-selection))
4875 (progn
4876 (anything-make-visible-mark)
4877 (anything-next-line)
4878 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4879 (anything-next-line)))
4880 (unless (anything-this-visible-mark)
4881 (anything-prev-visible-mark)))))
4883 (add-hook 'anything-after-update-hook #'anything-ff-maybe-mark-candidates)
4885 (defun* anything-dired-do-action-on-file (&key action)
4886 (let* ((files (dired-get-marked-files))
4887 (len (length files))
4888 (fname (if (> len 1)
4889 (format "* %d Files" len)
4890 (car files)))
4891 (source (case action
4892 ('copy 'anything-c-source-copy-files)
4893 ('rename 'anything-c-source-rename-files)
4894 ('symlink 'anything-c-source-symlink-files)
4895 ('hardlink 'anything-c-source-hardlink-files)))
4896 (prompt-fm (case action
4897 ('copy "Copy %s to: ")
4898 ('rename "Rename %s to: ")
4899 ('symlink "Symlink %s to: ")
4900 ('hardlink "Hardlink %s to: ")))
4901 (buffer (case action
4902 ('copy "*Anything Copy Files*")
4903 ('rename "*Anything Rename Files*")
4904 ('symlink "*Anything Symlink Files*")
4905 ('hardlink "*Anything Hardlink Files*")))
4906 (anything-mp-highlight-delay nil))
4907 (anything :sources source
4908 :input (or (dired-dwim-target-directory)
4909 (expand-file-name (anything-c-current-directory)))
4910 :preselect (dired-get-filename)
4911 :prompt (format prompt-fm fname)
4912 :keymap anything-c-read-file-map
4913 :buffer buffer)))
4915 ;;;###autoload
4916 (define-minor-mode anything-dired-mode ()
4917 "Enable anything completion in Dired functions.
4918 Bindings affected are C, R, S, H."
4919 :group 'anything-config
4920 :global t
4921 (if anything-dired-mode
4922 (progn
4923 (substitute-key-definition
4924 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4925 (substitute-key-definition
4926 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4927 (substitute-key-definition
4928 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4929 (substitute-key-definition
4930 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4931 (substitute-key-definition
4932 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4933 (substitute-key-definition
4934 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4935 (substitute-key-definition
4936 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4937 (substitute-key-definition
4938 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4940 (defalias 'anything-dired-bindings 'anything-dired-mode)
4942 (defun* anything-c-read-file-name (prompt
4943 &key
4944 (initial-input (expand-file-name default-directory))
4945 (buffer "*Anything Completions*")
4946 test
4947 (preselect nil)
4948 must-match
4949 (history nil)
4950 (marked-candidates nil)
4951 (alistp t)
4952 (persistent-action 'anything-find-files-persistent-action)
4953 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4954 "Anything `read-file-name' emulation.
4955 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4956 (when (get-buffer anything-action-buffer)
4957 (kill-buffer anything-action-buffer))
4958 (let ((anything-mp-highlight-delay nil)
4959 anything-same-window)
4960 (flet ((action-fn (candidate)
4961 (if marked-candidates
4962 (anything-marked-candidates)
4963 (identity candidate))))
4964 (or (anything
4965 :sources
4966 `(((name . "Read File Name History")
4967 (header-name . (lambda (name)
4968 (concat name anything-c-find-files-doc-header)))
4969 (disable-shortcuts)
4970 (candidates . (lambda ()
4971 (anything-comp-read-get-candidates history nil nil alistp)))
4972 (persistent-action . ,persistent-action)
4973 (persistent-help . ,persistent-help)
4974 (action . ,'action-fn))
4975 ((name . "Read file name")
4976 (header-name . (lambda (name)
4977 (concat name anything-c-find-files-doc-header)))
4978 ;; It is needed for filenames with capital letters
4979 (disable-shortcuts)
4980 (candidates . (lambda ()
4981 (let ((seq (anything-find-files-get-candidates)))
4982 (if test
4983 (loop
4984 for fname in seq when (funcall test fname)
4985 collect fname into ls
4986 finally return
4987 (if must-match ls
4988 (append (list anything-pattern) ls)))
4989 (if must-match
4990 (if (file-exists-p (car seq)) seq (cdr seq))
4991 seq)))))
4992 (filtered-candidate-transformer anything-c-find-files-transformer)
4993 (persistent-action . ,persistent-action)
4994 (candidate-number-limit . 9999)
4995 (toggle-auto-update . anything-ff-toggle-auto-update)
4996 (persistent-help . ,persistent-help)
4997 (volatile)
4998 (action . ,'action-fn)))
4999 :input initial-input
5000 :prompt prompt
5001 :keymap anything-c-read-file-map
5002 :resume 'noresume
5003 :buffer buffer
5004 :preselect preselect)
5005 (keyboard-quit)))))
5008 ;;; File Cache
5009 (defvar anything-c-file-cache-initialized-p nil)
5011 (defvar anything-c-file-cache-files nil)
5013 (defvar anything-c-source-file-cache
5014 '((name . "File Cache")
5015 (init
5016 . (lambda ()
5017 (require 'filecache nil t)
5018 (unless anything-c-file-cache-initialized-p
5019 (setq anything-c-file-cache-files
5020 (loop for item in file-cache-alist append
5021 (destructuring-bind (base &rest dirs) item
5022 (loop for dir in dirs collect
5023 (concat dir base)))))
5024 (defadvice file-cache-add-file (after file-cache-list activate)
5025 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
5026 (setq anything-c-file-cache-initialized-p t))))
5027 (candidates . anything-c-file-cache-files)
5028 (match anything-c-match-on-file-name
5029 anything-c-match-on-directory-name)
5030 (type . file)))
5031 ;; (anything 'anything-c-source-file-cache)
5034 ;;; Locate
5037 ;; NOTE for WINDOZE users:
5038 ;; You have to install Everything with his command line interface here:
5039 ;; http://www.voidtools.com/download.php
5041 (defvar anything-c-locate-command
5042 (case system-type
5043 ('gnu/linux "locate -i -r %s")
5044 ('berkeley-unix "locate -i %s")
5045 ('windows-nt "es -i -r %s")
5046 (t "locate %s"))
5047 "A list of arguments for locate program.
5048 The \"-r\" option must be the last option.")
5050 (defun anything-locate-1 (&optional localdb init)
5051 "Generic function to run Locate.
5052 if LOCALDB is non--nil search and use a local locate db file.
5053 INIT is a string to use as initial input in prompt.
5054 See `anything-locate-with-db' and `anything-locate'."
5055 (anything-locate-with-db
5056 (and localdb
5057 (anything-c-read-file-name
5058 "LocateDBFiles: "
5059 :marked-candidates t
5060 :preselect anything-locate-db-file-regexp
5061 :test #'(lambda (x)
5062 (if anything-locate-db-file-regexp
5063 ;; Select only locate db files and directories
5064 ;; to allow navigation.
5065 (or (string-match
5066 anything-locate-db-file-regexp x)
5067 (file-directory-p x))
5068 x))))
5069 init))
5070 ;; (anything-locate-1 t)
5072 (defun anything-locate-with-db (&optional db initial-input)
5073 "Run locate -d DB.
5074 If DB is not given or nil use locate without -d option.
5075 Argument DB can be given as a string or list of db files.
5076 Argument INITIAL-INPUT is a string to use as initial-input.
5077 See also `anything-locate'."
5078 (when (and db (stringp db)) (setq db (list db)))
5079 (let ((anything-c-locate-command
5080 (if db
5081 (replace-regexp-in-string
5082 "locate"
5083 (format "locate -d %s"
5084 (mapconcat 'identity
5085 ;; Remove eventually
5086 ;; marked directories by error.
5087 (loop for i in db
5088 unless (file-directory-p i)
5089 collect i) ":"))
5090 anything-c-locate-command)
5091 anything-c-locate-command)))
5092 (anything :sources 'anything-c-source-locate
5093 :buffer "*anything locate*"
5094 :input initial-input
5095 :keymap anything-generic-files-map)))
5096 ;; (anything-locate-with-db "~/locate.db")
5098 (defun anything-c-locate-init ()
5099 "Initialize async locate process for `anything-c-source-locate'."
5100 (setq mode-line-format
5101 '(" " mode-line-buffer-identification " "
5102 (line-number-mode "%l") " "
5103 (:eval (propertize "(Locate Process Running) "
5104 'face '((:foreground "red"))))))
5105 (prog1
5106 (start-process-shell-command "locate-process" nil
5107 (format anything-c-locate-command
5108 anything-pattern))
5109 (set-process-sentinel (get-process "locate-process")
5110 #'(lambda (process event)
5111 (when (string= event "finished\n")
5112 (with-anything-window
5113 (force-mode-line-update nil)
5114 (anything-update-move-first-line)))))))
5116 (defvar anything-c-source-locate
5117 '((name . "Locate")
5118 (candidates . anything-c-locate-init)
5119 (type . file)
5120 (properties-action . anything-ff-properties)
5121 (requires-pattern . 3)
5122 (candidate-number-limit . 9999)
5123 (mode-line . anything-generic-file-mode-line-string)
5124 (delayed))
5125 "Find files matching the current input pattern with locate.")
5126 ;; (anything 'anything-c-source-locate)
5129 ;;; Anything Incremental Grep.
5132 ;; Allow to grep incrementally with anything interface.
5133 ;; It allow also to Grep files recursively without using 'find' shell command.
5134 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
5135 (defvar anything-c-grep-default-command
5136 "grep -d skip %e -niH -e %p %f"
5137 "Default grep format command for `anything-do-grep-1'.
5138 Where:
5139 '%e' format spec is for --exclude or --include grep options.
5140 '%p' format spec is for pattern.
5141 '%f' format spec is for filenames.")
5143 (defvar anything-c-grep-default-recurse-command
5144 "grep -d recurse %e -niH -e %p %f"
5145 "Default recursive grep format command for `anything-do-grep-1'.
5146 See `anything-c-grep-default-command' for format specs.")
5148 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
5150 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
5152 (defvar anything-c-grep-default-function 'anything-c-grep-init)
5154 (defvar anything-c-grep-debug-command-line nil
5155 "Turn on anything grep command-line debugging when non--nil.")
5157 (defvar anything-c-zgrep-recurse-flag nil)
5159 (defvar anything-c-grep-history nil)
5161 (defvar anything-c-grep-max-length-history 100
5162 "*Max number of elements to save in `anything-c-grep-history'.")
5164 (defun anything-c-grep-prepare-candidates (candidates)
5165 "Prepare filenames and directories CANDIDATES for grep command line."
5166 ;; If one or more candidate is a directory, search in all files
5167 ;; of this candidate (e.g /home/user/directory/*).
5168 ;; If r option is enabled search also in subdidrectories.
5169 ;; We need here to expand wildcards to support crap windows filenames
5170 ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
5171 (if anything-c-zgrep-recurse-flag
5172 (mapconcat 'shell-quote-argument candidates " ")
5173 (loop for i in candidates append
5174 (cond ( ;; Candidate is a directory and we use recursion.
5175 (and (file-directory-p i)
5176 (anything-c-grep-recurse-p))
5177 (list (expand-file-name i)))
5178 ;; Candidate is a directory, search in all files.
5179 ((file-directory-p i)
5180 (file-expand-wildcards
5181 (concat (file-name-as-directory (expand-file-name i)) "*") t))
5182 ;; Candidate is a file or wildcard and we use recursion, use the
5183 ;; current directory instead of candidate.
5184 ((and (or (file-exists-p i) (string-match "\*" i))
5185 (anything-c-grep-recurse-p))
5186 (list (expand-file-name
5187 (directory-file-name ; Needed for windoze.
5188 (file-name-directory (directory-file-name i))))))
5189 ;; Candidate use wildcard.
5190 ((string-match "^\*" (anything-c-basename i))
5191 (file-expand-wildcards i t))
5192 ;; Else should be one or more file.
5193 (t (list i))) into all-files
5194 finally return
5195 (mapconcat 'shell-quote-argument all-files " "))))
5197 (defun anything-c-grep-recurse-p ()
5198 "Check if `anything-do-grep-1' have switched to recursive."
5199 (let ((args (replace-regexp-in-string
5200 "grep" "" anything-c-grep-default-command)))
5201 (string-match-p "r\\|recurse" args)))
5203 (defun anything-c-grep-init (only-files &optional include zgrep)
5204 "Start an asynchronous grep process in ONLY-FILES list."
5205 (let* ((fnargs (anything-c-grep-prepare-candidates
5206 (if (file-remote-p anything-ff-default-directory)
5207 (mapcar #'(lambda (x)
5208 (file-remote-p x 'localname))
5209 only-files)
5210 only-files)))
5211 (ignored-files (mapconcat
5212 #'(lambda (x)
5213 (concat "--exclude=" (shell-quote-argument x)))
5214 grep-find-ignored-files " "))
5215 (ignored-dirs (mapconcat
5216 ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
5217 #'(lambda (x)
5218 (concat "--exclude-dir=" (shell-quote-argument x)))
5219 grep-find-ignored-directories " "))
5220 (exclude (if (anything-c-grep-recurse-p)
5221 (concat (or include ignored-files) " " ignored-dirs)
5222 ignored-files))
5223 (cmd-line (format-spec
5224 anything-c-grep-default-command
5225 (delq nil
5226 (list (unless zgrep (cons ?e exclude))
5227 (cons ?p (shell-quote-argument anything-pattern))
5228 (cons ?f fnargs))))))
5229 (when anything-c-grep-debug-command-line
5230 (with-current-buffer (get-buffer-create "*any grep debug*")
5231 (goto-char (point-max))
5232 (insert (concat ">>> " cmd-line "\n\n"))))
5233 (setq mode-line-format
5234 '(" " mode-line-buffer-identification " "
5235 (line-number-mode "%l") " "
5236 (:eval (when (get-process "grep-process")
5237 (propertize "[Grep Process Running] "
5238 'face 'anything-grep-running)))))
5239 (force-mode-line-update nil)
5240 (prog1
5241 (let ((default-directory anything-ff-default-directory))
5242 (start-file-process-shell-command "grep-process" nil cmd-line))
5243 (message nil)
5244 (set-process-sentinel
5245 (get-process "grep-process")
5246 #'(lambda (process event)
5247 (when (string= event "finished\n")
5248 (with-anything-window
5249 (anything-update-move-first-line)
5250 (setq mode-line-format
5251 '(" " mode-line-buffer-identification " "
5252 (line-number-mode "%l") " "
5253 (:eval (propertize
5254 (format "[Grep Process Finished - (%s results)] "
5255 (let ((nlines (1- (count-lines
5256 (point-min)
5257 (point-max)))))
5258 (if (> nlines 0) nlines 0)))
5259 'face 'anything-grep-finish))))
5260 (force-mode-line-update nil))))))))
5262 (defun anything-c-grep-action (candidate &optional where mark)
5263 "Define a default action for `anything-do-grep' on CANDIDATE.
5264 WHERE can be one of other-window, elscreen, other-frame."
5265 (let* ((split (anything-c-grep-split-line candidate))
5266 (lineno (string-to-number (nth 1 split)))
5267 (loc-fname (car split))
5268 (tramp-method (file-remote-p anything-ff-default-directory 'method))
5269 (tramp-host (file-remote-p anything-ff-default-directory 'host))
5270 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
5271 (fname (if tramp-host
5272 (concat tramp-prefix loc-fname) loc-fname)))
5273 (case where
5274 (other-window (find-file-other-window fname))
5275 (elscreen (anything-elscreen-find-file fname))
5276 (other-frame (find-file-other-frame fname))
5277 (t (find-file fname)))
5278 (anything-goto-line lineno)
5279 (when mark
5280 (set-marker (mark-marker) (point))
5281 (push-mark (point) 'nomsg))
5282 ;; Save history
5283 (unless (or anything-in-persistent-action
5284 (string= anything-pattern ""))
5285 (setq anything-c-grep-history
5286 (cons anything-pattern
5287 (delete anything-pattern anything-c-grep-history)))
5288 (when (> (length anything-c-grep-history)
5289 anything-c-grep-max-length-history)
5290 (setq anything-c-grep-history
5291 (delete (car (last anything-c-grep-history))
5292 anything-c-grep-history))))))
5294 (defun anything-c-grep-other-window (candidate)
5295 "Jump to result in other window from anything grep."
5296 (anything-c-grep-action candidate 'other-window))
5298 (defun anything-c-grep-other-frame (candidate)
5299 "Jump to result in other frame from anything grep."
5300 (anything-c-grep-action candidate 'other-frame))
5302 (defun anything-c-grep-jump-elscreen (candidate)
5303 "Jump to result in elscreen from anything grep."
5304 (anything-c-grep-action candidate 'elscreen))
5306 (defun anything-c-grep-save-results (candidate)
5307 "Save anything grep result in a `grep-mode' buffer."
5308 (let ((buf "*grep*")
5309 new-buf)
5310 (when (get-buffer buf)
5311 (setq new-buf (read-string "GrepBufferName: " buf))
5312 (loop for b in (anything-c-buffer-list)
5313 when (and (string= new-buf b)
5314 (not (y-or-n-p
5315 (format "Buffer `%s' already exists overwrite? "
5316 new-buf))))
5317 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
5318 (setq buf new-buf))
5319 (with-current-buffer (get-buffer-create buf)
5320 (let ((inhibit-read-only t))
5321 (erase-buffer)
5322 (insert "-*- mode: grep -*-\n\n"
5323 (format "Grep Results for `%s':\n\n" anything-pattern))
5324 (save-excursion
5325 (insert (with-current-buffer anything-buffer
5326 (forward-line 1)
5327 (buffer-substring (point) (point-max))))
5328 (grep-mode))))
5329 (message "Anything Grep Results saved in `%s' buffer" buf)))
5331 (defun anything-c-grep-persistent-action (candidate)
5332 "Persistent action for `anything-do-grep'.
5333 With a prefix arg record CANDIDATE in `mark-ring'."
5334 (if current-prefix-arg
5335 (anything-c-grep-action candidate nil 'mark)
5336 (anything-c-grep-action candidate))
5337 (anything-match-line-color-current-line))
5339 (defun anything-c-grep-guess-extensions (files)
5340 "Try to guess file extensions in FILES list when using grep recurse.
5341 These extensions will be added to command line with --include arg of grep."
5342 (loop
5343 with glob-list = nil
5344 with lst = (if (file-directory-p (car files))
5345 (directory-files
5346 (car files) nil
5347 directory-files-no-dot-files-regexp)
5348 files)
5349 for i in lst
5350 for ext = (file-name-extension i t)
5351 for glob = (and ext (not (string= ext ""))
5352 (concat "*" ext))
5353 unless (or (not glob)
5354 (member glob glob-list)
5355 (member glob grep-find-ignored-files))
5356 collect glob into glob-list
5357 finally return glob-list))
5359 (defun anything-do-grep-1 (only &optional recurse zgrep)
5360 "Launch grep with a list of ONLY files.
5361 When RECURSE is given use -r option of grep and prompt user
5362 to set the --include args of grep.
5363 You can give more than one arg separated by space.
5364 e.g *.el *.py *.tex.
5365 If it's empty --exclude `grep-find-ignored-files' is used instead."
5366 (let* ((anything-compile-source-functions
5367 ;; rule out anything-match-plugin because the input is one regexp.
5368 (delq 'anything-compile-source--match-plugin
5369 (copy-sequence anything-compile-source-functions)))
5370 (exts (anything-c-grep-guess-extensions only))
5371 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
5372 (include-files (and recurse (not zgrep)
5373 (read-string "OnlyExt(*.[ext]): "
5374 globs)))
5375 ;; Set `minibuffer-history' AFTER includes-files
5376 ;; to avoid storing wild-cards here.
5377 (minibuffer-history anything-c-grep-history)
5378 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
5379 (recurse anything-c-grep-default-recurse-command)
5380 (zgrep anything-c-default-zgrep-command)
5381 (t anything-c-grep-default-command)))
5382 ;; Disable match-plugin and use here own highlighting.
5383 (anything-mp-highlight-delay nil))
5384 (when include-files
5385 (setq include-files
5386 (and (not (string= include-files ""))
5387 (mapconcat #'(lambda (x)
5388 (concat "--include=" (shell-quote-argument x)))
5389 (split-string include-files) " "))))
5390 ;; When called as action from an other source e.g *-find-files
5391 ;; we have to kill action buffer.
5392 (when (get-buffer anything-action-buffer)
5393 (kill-buffer anything-action-buffer))
5394 ;; `anything-find-files' haven't already started,
5395 ;; give a default value to `anything-ff-default-directory'.
5396 (setq anything-ff-default-directory (or anything-ff-default-directory
5397 default-directory))
5398 (anything
5399 :sources
5400 `(((name . "Grep (C-c ? Help)")
5401 (candidates
5402 . (lambda ()
5403 (funcall anything-c-grep-default-function only include-files zgrep)))
5404 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5405 (candidate-number-limit . 9999)
5406 (mode-line . anything-grep-mode-line-string)
5407 (jump-persistent . anything-c-grep-persistent-action)
5408 (action . ,(delq
5410 `(("Find File" . anything-c-grep-action)
5411 ("Find file other frame" . anything-c-grep-other-frame)
5412 ,(and (locate-library "elscreen")
5413 '("Find file in Elscreen"
5414 . anything-c-grep-jump-elscreen))
5415 ("Save results in grep buffer" . anything-c-grep-save-results)
5416 ("Find file other window" . anything-c-grep-other-window))))
5417 (persistent-action . anything-c-grep-persistent-action)
5418 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
5419 (requires-pattern . 3)
5420 (delayed)))
5421 :keymap anything-c-grep-map
5422 :buffer "*anything grep*")))
5424 (defun anything-ff-zgrep-1 (flist recursive)
5425 (unwind-protect
5426 (let* ((def-dir (or anything-ff-default-directory
5427 default-directory))
5428 (only (if recursive
5429 (or (gethash def-dir anything-c-rzgrep-cache)
5430 (puthash
5431 def-dir
5432 (anything-c-walk-directory
5433 def-dir
5434 :directories nil
5435 :path 'full
5436 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
5437 anything-c-rzgrep-cache))
5438 flist)))
5439 (when recursive (setq anything-c-zgrep-recurse-flag t))
5440 (anything-do-grep-1 only recursive 'zgrep))
5441 (setq anything-c-zgrep-recurse-flag nil)))
5443 (defun anything-c-grep-split-line (line)
5444 "Split a grep output line."
5445 (let (beg fname lineno str)
5446 ;; Don't print until grep line is valid.
5447 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
5448 (with-temp-buffer
5449 (insert line)
5450 (goto-char (point-min))
5451 (setq beg (point))
5452 (forward-char 2)
5453 (re-search-forward ":" nil t)
5454 (setq fname (buffer-substring-no-properties beg (1- (point))))
5455 (setq beg (point))
5456 (re-search-forward ":" nil t)
5457 (setq lineno (buffer-substring-no-properties beg (1- (point))))
5458 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
5459 (list fname lineno str))))
5461 (defun anything-c-grep-cand-transformer (candidates sources)
5462 "Filtered candidate transformer function for `anything-do-grep'."
5463 (loop for i in candidates
5464 for split = (and i (anything-c-grep-split-line i))
5465 for fname = (car split)
5466 for lineno = (nth 1 split)
5467 for str = (nth 2 split)
5468 when (and fname lineno str)
5469 collect
5470 (cons (concat (propertize (file-name-nondirectory fname)
5471 'face 'anything-grep-file
5472 'help-echo fname) ":"
5473 (propertize lineno 'face 'anything-grep-lineno) ":"
5474 (anything-c-grep-highlight-match str))
5475 i)))
5477 (defun anything-c-grep-highlight-match (str)
5478 "Highlight in string STR all occurences matching `anything-pattern'."
5479 (condition-case nil
5480 (with-temp-buffer
5481 (insert str)
5482 (goto-char (point-min))
5483 (while (and (re-search-forward anything-pattern nil t)
5484 (> (- (match-end 0) (match-beginning 0)) 0))
5485 (add-text-properties
5486 (match-beginning 0) (match-end 0)
5487 '(face anything-grep-match)))
5488 (buffer-string))
5489 (error nil)))
5491 ;; Go to next or precedent file (common to etags and grep).
5492 (defun anything-c-goto-next-or-prec-file (n)
5493 "Go to next or precedent candidate file in anything grep/etags buffers.
5494 If N is positive go forward otherwise go backward."
5495 (with-anything-window
5496 (let* ((current-line-list (split-string
5497 (buffer-substring
5498 (point-at-bol)
5499 (point-at-eol)) ":"))
5500 (current-fname (nth 0 current-line-list))
5501 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
5502 (catch 'break
5503 (while (not (funcall fn-b-o-f))
5504 (forward-line n) ; Go forward or backward depending of n value.
5505 (unless (search-forward current-fname (point-at-eol) t)
5506 (anything-mark-current-line)
5507 (throw 'break nil))))
5508 (cond ((and (eq n 1) (eobp))
5509 (re-search-backward ".")
5510 (forward-line 0)
5511 (anything-mark-current-line))
5512 ((and (< n 1) (bobp))
5513 (forward-line 1)
5514 (anything-mark-current-line))))))
5516 ;;;###autoload
5517 (defun anything-c-goto-precedent-file ()
5518 "Go to precedent file in anything grep/etags buffers."
5519 (interactive)
5520 (anything-c-goto-next-or-prec-file -1))
5522 ;;;###autoload
5523 (defun anything-c-goto-next-file ()
5524 "Go to precedent file in anything grep/etags buffers."
5525 (interactive)
5526 (anything-c-goto-next-or-prec-file 1))
5528 ;;;###autoload
5529 (defun anything-c-grep-run-persistent-action ()
5530 "Run grep persistent action from `anything-do-grep-1'."
5531 (interactive)
5532 (anything-execute-persistent-action 'jump-persistent))
5534 ;;;###autoload
5535 (defun anything-c-grep-run-default-action ()
5536 "Run grep default action from `anything-do-grep-1'."
5537 (interactive)
5538 (anything-c-quit-and-execute-action 'anything-c-grep-action))
5540 ;;;###autoload
5541 (defun anything-c-grep-run-other-window-action ()
5542 "Run grep goto other window action from `anything-do-grep-1'."
5543 (interactive)
5544 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5546 ;;;###autoload
5547 (defun anything-c-grep-run-save-buffer ()
5548 "Run grep save results action from `anything-do-grep-1'."
5549 (interactive)
5550 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5552 ;; Grep buffers
5553 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5554 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5555 If one of selected buffers is not a file--buffer,
5556 it is ignored and grep will run on all others file--buffers.
5557 If only one candidate is selected and it is not a file--buffer,
5558 switch to this buffer and run `anything-occur'.
5559 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5560 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5561 (cands (if prefarg
5562 (buffer-list)
5563 (anything-marked-candidates)))
5564 (win-conf (current-window-configuration))
5565 ;; Non--fname buffers are ignored.
5566 (bufs (loop for buf in cands
5567 for fname = (buffer-file-name (get-buffer buf))
5568 when fname
5569 collect (expand-file-name fname))))
5570 (if bufs
5571 (if zgrep
5572 (anything-do-grep-1 bufs nil 'zgrep)
5573 (anything-do-grep-1 bufs))
5574 ;; bufs is empty, thats mean we have only CANDIDATE
5575 ;; and it is not a buffer-filename, fallback to occur.
5576 (anything-c-switch-to-buffer candidate)
5577 (when (get-buffer anything-action-buffer)
5578 (kill-buffer anything-action-buffer))
5579 (anything-occur)
5580 (when (eq anything-exit-status 1)
5581 (set-window-configuration win-conf)))))
5583 (defun anything-c-grep-buffers (candidate)
5584 "Action to grep buffers."
5585 (anything-c-grep-buffers-1 candidate))
5587 (defun anything-c-zgrep-buffers (candidate)
5588 "Action to zgrep buffers."
5589 (anything-c-grep-buffers-1 candidate 'zgrep))
5592 ;;; Anything interface for pdfgrep
5593 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
5594 ;; and a pdf-reader (e.g xpdf) are needed.
5596 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5597 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5598 (defvar anything-c-pdfgrep-debug-command-line nil)
5600 (defun anything-c-pdfgrep-init (only-files)
5601 "Start an asynchronous pdfgrep process in ONLY-FILES list."
5602 (let* ((fnargs (anything-c-grep-prepare-candidates
5603 (if (file-remote-p anything-ff-default-directory)
5604 (mapcar #'(lambda (x)
5605 (file-remote-p x 'localname))
5606 only-files)
5607 only-files)))
5608 (cmd-line (format anything-c-pdfgrep-default-command
5609 anything-pattern
5610 fnargs)))
5611 (when anything-c-pdfgrep-debug-command-line
5612 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5613 (goto-char (point-max))
5614 (insert (concat ">>> " cmd-line "\n\n"))))
5615 (setq mode-line-format
5616 '(" " mode-line-buffer-identification " "
5617 (line-number-mode "%l") " "
5618 (:eval (propertize "(Pdfgrep Process Running) "
5619 'face '((:foreground "red"))))))
5620 (prog1
5621 (let ((default-directory anything-ff-default-directory))
5622 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5623 (message nil)
5624 (set-process-sentinel
5625 (get-process "pdfgrep-process")
5626 #'(lambda (process event)
5627 (when (string= event "finished\n")
5628 (with-anything-window
5629 (anything-update-move-first-line))
5630 (force-mode-line-update nil)))))))
5633 (defun anything-do-pdfgrep-1 (only)
5634 "Launch pdfgrep with a list of ONLY files."
5635 (unless (executable-find "pdfgrep")
5636 (error "Error: No such program `pdfgrep'."))
5637 (let* ((anything-compile-source-functions
5638 ;; rule out anything-match-plugin because the input is one regexp.
5639 (delq 'anything-compile-source--match-plugin
5640 (copy-sequence anything-compile-source-functions)))
5641 ;; Disable match-plugin and use here own highlighting.
5642 (anything-mp-highlight-delay nil))
5643 ;; When called as action from an other source e.g *-find-files
5644 ;; we have to kill action buffer.
5645 (when (get-buffer anything-action-buffer)
5646 (kill-buffer anything-action-buffer))
5647 ;; If `anything-find-files' haven't already started,
5648 ;; give a default value to `anything-ff-default-directory'.
5649 (setq anything-ff-default-directory (or anything-ff-default-directory
5650 default-directory))
5651 (anything
5652 :sources
5653 `(((name . "PdfGrep")
5654 (candidates
5655 . (lambda ()
5656 (funcall anything-c-pdfgrep-default-function only)))
5657 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5658 (candidate-number-limit . 9999)
5659 (mode-line . anything-pdfgrep-mode-line-string)
5660 (action . anything-c-pdfgrep-action)
5661 (persistent-help . "Jump to PDF Page")
5662 (requires-pattern . 3)
5663 (delayed)))
5664 :keymap anything-c-pdfgrep-map
5665 :buffer "*anything grep*")))
5668 (defun anything-c-pdfgrep-action (candidate)
5669 (let* ((split (anything-c-grep-split-line candidate))
5670 (pageno (nth 1 split))
5671 (fname (car split)))
5672 (start-file-process-shell-command
5673 "pdf-reader" nil
5674 (format-spec anything-c-pdfgrep-default-read-command
5675 (list (cons ?f fname) (cons ?p pageno))))))
5677 (defun anything-do-pdfgrep ()
5678 (interactive)
5679 (let ((only (anything-c-read-file-name
5680 "Search in file(s): "
5681 :marked-candidates t
5682 :test #'(lambda (file)
5683 (or (string= (file-name-extension file) "pdf")
5684 (string= (file-name-extension file) "PDF")
5685 (file-directory-p file)))
5686 :preselect (or (dired-get-filename nil t)
5687 (buffer-file-name (current-buffer)))))
5688 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
5689 (anything-do-pdfgrep-1 only)))
5692 ;; Yank text at point.
5695 ;; Internal
5696 (defvar anything-yank-point nil)
5698 ;;;###autoload
5699 (defun anything-yank-text-at-point ()
5700 "Yank text at point in minibuffer."
5701 (interactive)
5702 (let (input)
5703 (flet ((insert-in-minibuffer (word)
5704 (with-selected-window (minibuffer-window)
5705 (let ((str anything-pattern))
5706 (delete-minibuffer-contents)
5707 (set-text-properties 0 (length word) nil word)
5708 (insert (concat str word))))))
5709 (with-anything-current-buffer
5710 ;; Start to initial point if C-w have never been hit.
5711 (unless anything-yank-point (setq anything-yank-point (point)))
5712 (and anything-yank-point (goto-char anything-yank-point))
5713 (forward-word 1)
5714 (setq input (buffer-substring-no-properties anything-yank-point (point)))
5715 (setq anything-yank-point (point))) ; End of last forward-word
5716 (insert-in-minibuffer input))))
5718 (defun anything-reset-yank-point ()
5719 (setq anything-yank-point nil))
5721 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5722 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5723 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
5726 ;;; Recentf files
5729 (defvar anything-c-source-recentf
5730 '((name . "Recentf")
5731 (init . (lambda ()
5732 (require 'recentf)
5733 (or recentf-mode (recentf-mode 1))
5734 ;; Big value empowers anything/recentf
5735 (when (and (numberp recentf-max-saved-items)
5736 (<= recentf-max-saved-items 20))
5737 (setq recentf-max-saved-items 500))))
5738 (candidates . recentf-list)
5739 (match anything-c-match-on-file-name
5740 anything-c-match-on-directory-name)
5741 (type . file))
5742 "See (info \"(emacs)File Conveniences\").
5743 if `recentf-max-saved-items' is too small, set it to 500.")
5744 ;; (anything 'anything-c-source-recentf)
5746 ;;; ffap
5747 (eval-when-compile (require 'ffap))
5748 (defvar anything-c-source-ffap-guesser
5749 '((name . "File at point")
5750 (init . (lambda () (require 'ffap)))
5751 (candidates . (lambda ()
5752 (anything-aif
5753 (with-anything-current-buffer
5754 (ffap-guesser))
5755 (list it))))
5756 (type . file)))
5757 ;; (anything 'anything-c-source-ffap-guesser)
5759 ;;; ffap with line number
5760 (defun anything-c-ffap-file-line-at-point ()
5761 "Get (FILENAME . LINENO) at point."
5762 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5763 (save-excursion
5764 (beginning-of-line)
5765 (when (and (search-forward it nil t)
5766 (looking-at ":\\([0-9]+\\)"))
5767 (cons it (string-to-number (match-string 1)))))))
5769 (defvar anything-c-ffap-line-location nil
5770 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5771 It is cleared after jumping line.")
5773 (defun anything-c-ffap-line-candidates ()
5774 (with-anything-current-buffer
5775 (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5776 (when anything-c-ffap-line-location
5777 (destructuring-bind (file . line) anything-c-ffap-line-location
5778 (list (cons (format "%s (line %d)" file line) file)))))
5780 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5781 (defun anything-c-ffap-line-goto-line ()
5782 (when (car anything-c-ffap-line-location)
5783 (unwind-protect
5784 (ignore-errors
5785 (with-selected-window
5786 (get-buffer-window
5787 (get-file-buffer (car anything-c-ffap-line-location)))
5788 (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5789 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5790 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5792 (defvar anything-c-source-ffap-line
5793 '((name . "File/Lineno at point")
5794 (init . (lambda () (require 'ffap)))
5795 (candidates . anything-c-ffap-line-candidates)
5796 (type . file)))
5797 ;; (anything 'anything-c-source-ffap-line)
5799 ;;; list of files gleaned from every dired buffer
5800 (defun anything-c-files-in-all-dired-candidates ()
5801 (save-excursion
5802 (mapcan
5803 (lambda (dir)
5804 (cond ((listp dir) ;filelist
5805 dir)
5806 ((equal "" (file-name-nondirectory dir)) ;dir
5807 (directory-files dir t))
5808 (t ;wildcard
5809 (file-expand-wildcards dir t))))
5810 (delq nil
5811 (mapcar (lambda (buf)
5812 (set-buffer buf)
5813 (when (eq major-mode 'dired-mode)
5814 (if (consp dired-directory)
5815 (cdr dired-directory) ;filelist
5816 dired-directory))) ;dir or wildcard
5817 (buffer-list))))))
5818 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5820 (defvar anything-c-source-files-in-all-dired
5821 '((name . "Files in all dired buffer.")
5822 (candidates . anything-c-files-in-all-dired-candidates)
5823 (type . file)))
5824 ;; (anything 'anything-c-source-files-in-all-dired)
5826 (defvar anything-c-source-filelist
5827 '((name . "FileList")
5828 (grep-candidates . anything-c-filelist-file-name)
5829 (candidate-number-limit . 200)
5830 (requires-pattern . 4)
5831 (type . file))
5832 "Source to find files instantly.
5833 See `anything-c-filelist-file-name' docstring for usage.")
5836 ;;;; <info>
5837 ;;; Info pages
5838 (defvar anything-c-info-pages nil
5839 "All info pages on system.
5840 Will be calculated the first time you invoke anything with this
5841 source.")
5843 (defvar anything-c-source-info-pages
5844 `((name . "Info Pages")
5845 (candidates
5846 . (lambda ()
5847 (if anything-c-info-pages
5848 anything-c-info-pages
5849 (setq anything-c-info-pages
5850 (save-window-excursion
5851 (save-excursion
5852 (require 'info)
5853 (Info-find-node "dir" "top")
5854 (goto-char (point-min))
5855 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5856 topics)
5857 (while (re-search-forward info-topic-regexp nil t)
5858 (add-to-list 'topics (match-string-no-properties 1)))
5859 (goto-char (point-min))
5860 (Info-exit)
5861 topics)))))))
5862 (action . (("Show with Info" .(lambda (node-str)
5863 (info (replace-regexp-in-string
5864 "^[^:]+: " "" node-str))))))
5865 (requires-pattern . 2)))
5866 ;; (anything 'anything-c-source-info-pages)
5869 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5870 (defun anything-c-describe-attributes (anything-attribute)
5871 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5872 Same as `anything-describe-anything-attribute' but with anything completion."
5873 (interactive (list (intern
5874 (anything-comp-read
5875 "Describe anything attribute: "
5876 (mapcar 'symbol-name anything-additional-attributes)
5877 :must-match t
5878 :persistent-action
5879 #'(lambda (candidate)
5880 (with-output-to-temp-buffer "*Help*"
5881 (princ (get (intern candidate) 'anything-attrdoc))))))))
5882 (with-output-to-temp-buffer "*Help*"
5883 (princ (get anything-attribute 'anything-attrdoc))))
5886 ;;; Use info-index plug-in.
5889 ;; Note that `name' attribute is not needed since
5890 ;; `anything-c-insert-summary' have been removed.
5891 ;; Info Elisp
5892 (defvar anything-c-source-info-elisp
5893 '((name . "Info index: elisp")
5894 (info-index . "elisp")))
5895 ;; (anything 'anything-c-source-info-elisp)
5897 ;; Info-Common-Lisp
5898 (defvar anything-c-source-info-cl
5899 '((name . "Info index: cl")
5900 (info-index . "cl")))
5901 ;; (anything 'anything-c-source-info-cl)
5903 ;; Info Index org
5904 (defvar anything-c-source-info-org
5905 '((name . "Info index: org")
5906 (info-index . "org")))
5907 ;; (anything 'anything-c-source-info-org)
5909 ;; Info Index gnus
5910 (defvar anything-c-source-info-gnus
5911 '((name . "Info index: Gnus")
5912 (info-index . "gnus")))
5914 ;; Info Index ratpoison
5915 (defvar anything-c-source-info-ratpoison
5916 '((name . "Info index: ratpoison")
5917 (info-index . "ratpoison")))
5918 ;; (anything 'anything-c-source-info-ratpoison)
5920 ;; Info Index zsh
5921 (defvar anything-c-source-info-zsh
5922 '((name . "Info index: zsh")
5923 (info-index . "zsh")))
5924 ;; (anything 'anything-c-source-info-zsh)
5926 ;; Info Index bash
5927 (defvar anything-c-source-info-bash
5928 '((name . "Info index: bash")
5929 (info-index . "bash")))
5930 ;; (anything 'anything-c-source-info-bash)
5932 ;; Info Index coreutils
5933 (defvar anything-c-source-info-coreutils
5934 '((name . "Info index: coreutils")
5935 (info-index . "coreutils")))
5936 ;; (anything 'anything-c-source-info-coreutils)
5938 ;; Info Index fileutils
5939 (defvar anything-c-source-info-fileutils
5940 '((name . "Info index: fileutils")
5941 (info-index . "fileutils")))
5942 ;; (anything 'anything-c-source-info-fileutils)
5944 ;; Info Index find
5945 (defvar anything-c-source-info-find
5946 '((name . "Info index: find")
5947 (info-index . "find")))
5948 ;; (anything 'anything-c-source-info-find)
5950 ;; Info Index sh-utils
5951 (defvar anything-c-source-info-sh-utils
5952 '((name . "Info index: sh-utils")
5953 (info-index . "sh-utils")))
5954 ;; (anything 'anything-c-source-info-sh-utils)
5956 ;; Info Index textutils
5957 (defvar anything-c-source-info-textutils
5958 '((name . "Info index: textutils")
5959 (info-index . "textutils")))
5960 ;; (anything 'anything-c-source-info-textutils)
5962 ;; Info Index libc
5963 (defvar anything-c-source-info-libc
5964 '((name . "Info index: libc")
5965 (info-index . "libc")))
5966 ;; (anything 'anything-c-source-info-libc)
5968 ;; Info Index make
5969 (defvar anything-c-source-info-make
5970 '((name . "Info index: make")
5971 (info-index . "make")))
5972 ;; (anything 'anything-c-source-info-make)
5974 ;; Info Index automake
5975 (defvar anything-c-source-info-automake
5976 '((name . "Info index: automake")
5977 (info-index . "automake")))
5978 ;; (anything 'anything-c-source-info-automake)
5980 ;; Info Index autoconf
5981 (defvar anything-c-source-info-autoconf
5982 '((name . "Info index: autoconf")
5983 (info-index . "autoconf")))
5984 ;; (anything 'anything-c-source-info-autoconf)
5986 ;; Info Index emacs-lisp-intro
5987 (defvar anything-c-source-info-emacs-lisp-intro
5988 '((name . "Info index: emacs-lisp-intro")
5989 (info-index . "emacs-lisp-intro")))
5990 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
5992 ;; Info Index emacs
5993 (defvar anything-c-source-info-emacs
5994 '((name . "Info index: emacs")
5995 (info-index . "emacs")))
5996 ;; (anything 'anything-c-source-info-emacs)
5998 ;; Info Index elib
5999 (defvar anything-c-source-info-elib
6000 '((name . "Info index: elib")
6001 (info-index . "elib")))
6002 ;; (anything 'anything-c-source-info-elib)
6004 ;; Info Index eieio
6005 (defvar anything-c-source-info-eieio
6006 '((name . "Info index: eieio")
6007 (info-index . "eieio")))
6008 ;; (anything 'anything-c-source-info-eieio)
6010 ;; Info Index gauche-refe
6011 (defvar anything-c-source-info-gauche-refe
6012 '((name . "Info index: gauche")
6013 (info-index . "gauche-refe")))
6014 ;; (anything 'anything-c-source-info-gauche-refe)
6016 ;; Info Index guile
6017 (defvar anything-c-source-info-guile
6018 '((name . "Info index: guile")
6019 (info-index . "guile")))
6020 ;; (anything 'anything-c-source-info-guile)
6022 ;; Info Index guile-tut
6023 (defvar anything-c-source-info-guile-tut
6024 '((name . "Info index: guile-tut")
6025 (info-index . "guile-tut")))
6026 ;; (anything 'anything-c-source-info-guile-tut)
6028 ;; Info Index goops
6029 (defvar anything-c-source-info-goops
6030 '((name . "Info index: goops")
6031 (info-index . "goops")))
6032 ;; (anything 'anything-c-source-info-goops)
6034 ;; Info Index screen
6035 (defvar anything-c-source-info-screen
6036 '((name . "Info index: screen")
6037 (info-index . "screen")
6038 (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
6039 ;; (anything 'anything-c-source-info-screen)
6041 ;; Info Index latex
6042 (defvar anything-c-source-info-latex
6043 '((name . "Info index: latex")
6044 (info-index . "latex")))
6045 ;; (anything 'anything-c-source-info-latex)
6047 ;; Info Index gawk
6048 (defvar anything-c-source-info-gawk
6049 '((name . "Info index: gawk")
6050 (info-index . "gawk")))
6051 ;; (anything 'anything-c-source-info-gawk)
6053 ;; Info Index sed
6054 (defvar anything-c-source-info-sed
6055 '((name . "Info index: sed")
6056 (info-index . "sed")))
6057 ;; (anything 'anything-c-source-info-sed)
6059 ;; Info Index m4
6060 (defvar anything-c-source-info-m4
6061 '((name . "Info index: m4")
6062 (info-index . "m4")))
6063 ;; (anything 'anything-c-source-info-m4)
6065 ;; Info Index wget
6066 (defvar anything-c-source-info-wget
6067 '((name . "Info index: wget")
6068 (info-index . "wget")))
6069 ;; (anything 'anything-c-source-info-wget)
6071 ;; Info Index binutils
6072 (defvar anything-c-source-info-binutils
6073 '((name . "Info index: binutils")
6074 (info-index . "binutils")))
6075 ;; (anything 'anything-c-source-info-binutils)
6077 ;; Info Index as
6078 (defvar anything-c-source-info-as
6079 '((name . "Info index: as")
6080 (info-index . "as")))
6081 ;; (anything 'anything-c-source-info-as)
6083 ;; Info Index bfd
6084 (defvar anything-c-source-info-bfd
6085 '((name . "Info index: bfd")
6086 (info-index . "bfd")))
6087 ;; (anything 'anything-c-source-info-bfd)
6089 ;; Info Index gprof
6090 (defvar anything-c-source-info-gprof
6091 '((name . "Info index: gprof")
6092 (info-index . "gprof")))
6093 ;; (anything 'anything-c-source-info-gprof)
6095 ;; Info Index ld
6096 (defvar anything-c-source-info-ld
6097 '((name . "Info index: ld")
6098 (info-index . "ld")))
6099 ;; (anything 'anything-c-source-info-ld)
6101 ;; Info Index diff
6102 (defvar anything-c-source-info-diff
6103 '((name . "Info index: diff")
6104 (info-index . "diff")))
6105 ;; (anything 'anything-c-source-info-diff)
6107 ;; Info Index flex
6108 (defvar anything-c-source-info-flex
6109 '((name . "Info index: flex")
6110 (info-index . "flex")))
6111 ;; (anything 'anything-c-source-info-flex)
6113 ;; Info Index grep
6114 (defvar anything-c-source-info-grep
6115 '((name . "Info index: grep")
6116 (info-index . "grep")))
6117 ;; (anything 'anything-c-source-info-grep)
6119 ;; Info Index gzip
6120 (defvar anything-c-source-info-gzip
6121 '((name . "Info index: gzip")
6122 (info-index . "gzip")))
6123 ;; (anything 'anything-c-source-info-gzip)
6125 ;; Info Index libtool
6126 (defvar anything-c-source-info-libtool
6127 '((name . "Info index: libtool")
6128 (info-index . "libtool")))
6129 ;; (anything 'anything-c-source-info-libtool)
6131 ;; Info Index texinfo
6132 (defvar anything-c-source-info-texinfo
6133 '((name . "Info index: texinfo")
6134 (info-index . "texinfo")))
6135 ;; (anything 'anything-c-source-info-texinfo)
6137 ;; Info Index info
6138 (defvar anything-c-source-info-info
6139 '((name . "Info index: info")
6140 (info-index . "info")))
6141 ;; (anything 'anything-c-source-info-info)
6143 ;; Info Index gdb
6144 (defvar anything-c-source-info-gdb
6145 '((name . "Info index: gdb")
6146 (info-index . "gdb")))
6147 ;; (anything 'anything-c-source-info-gdb)
6149 ;; Info Index stabs
6150 (defvar anything-c-source-info-stabs
6151 '((name . "Info index: stabs")
6152 (info-index . "stabs")))
6153 ;; (anything 'anything-c-source-info-stabs)
6155 ;; Info Index cvsbook
6156 (defvar anything-c-source-info-cvsbook
6157 '((name . "Info index: cvsbook")
6158 (info-index . "cvsbook")))
6159 ;; (anything 'anything-c-source-info-cvsbook)
6161 ;; Info Index cvs
6162 (defvar anything-c-source-info-cvs
6163 '((name . "Info index: cvs")
6164 (info-index . "cvs")))
6165 ;; (anything 'anything-c-source-info-cvs)
6167 ;; Info Index bison
6168 (defvar anything-c-source-info-bison
6169 '((name . "Info index: bison")
6170 (info-index . "bison")))
6171 ;; (anything 'anything-c-source-info-bison)
6173 ;; Info Index id-utils
6174 (defvar anything-c-source-info-id-utils
6175 '((name . "Info index: id-utils")
6176 (info-index . "id-utils")))
6177 ;; (anything 'anything-c-source-info-id-utils)
6179 ;; Info Index global
6180 (defvar anything-c-source-info-global
6181 '((name . "Info index: global")
6182 (info-index . "global")))
6183 ;; (anything 'anything-c-source-info-global)
6186 ;;;; <Help>
6187 ;;; Man and woman UI
6190 (defvar anything-c-man-pages nil
6191 "All man pages on system.
6192 Will be calculated the first time you invoke anything with this
6193 source.")
6195 (defun anything-c-man-default-action (candidate)
6196 "Default action for jumping to a woman or man page from anything."
6197 (let ((wfiles (woman-file-name-all-completions candidate)))
6198 (condition-case err
6199 (if (> (length wfiles) 1)
6200 (woman-find-file
6201 (anything-comp-read
6202 "ManFile: " wfiles :must-match t))
6203 (woman candidate))
6204 ;; If woman is unable to format correctly
6205 ;; use man instead.
6206 (error (kill-buffer) ; Kill woman buffer.
6207 (let ((Man-notify-method 'meek))
6208 (Man-getpage-in-background candidate))))))
6210 (defvar anything-c-source-man-pages
6211 `((name . "Manual Pages")
6212 (candidates . (lambda ()
6213 (if anything-c-man-pages
6214 anything-c-man-pages
6215 ;; XEmacs doesn't have a woman :)
6216 (setq anything-c-man-pages
6217 (ignore-errors
6218 (require 'woman)
6219 (woman-file-name "")
6220 (sort (mapcar 'car woman-topic-all-completions)
6221 'string-lessp))))))
6222 (action ("Show with Woman" . anything-c-man-default-action))
6223 ;; Woman does not work OS X
6224 ;; http://xahlee.org/emacs/modernization_man_page.html
6225 (action-transformer . (lambda (actions candidate)
6226 (if (eq system-type 'darwin)
6227 '(("Show with Man" . man))
6228 actions)))
6229 (requires-pattern . 2)))
6230 ;; (anything 'anything-c-source-man-pages)
6233 ;;;; <Command>
6234 ;;; Complex command history
6237 (defvar anything-c-source-complex-command-history
6238 '((name . "Complex Command History")
6239 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
6240 (type . sexp)))
6241 ;; (anything 'anything-c-source-complex-command-history)
6243 ;;; M-x history (not related to `anything-M-x')
6246 (defvar anything-c-source-extended-command-history
6247 '((name . "Emacs Commands History")
6248 (candidates . extended-command-history)
6249 (type . command)))
6250 ;; (anything 'anything-c-source-extended-command-history)
6252 ;;; Emacs commands (Basic source for emacs commands)
6255 (defvar anything-c-source-emacs-commands
6256 '((name . "Emacs Commands")
6257 (candidates . (lambda ()
6258 (let (commands)
6259 (mapatoms (lambda (a)
6260 (if (commandp a)
6261 (push (symbol-name a)
6262 commands))))
6263 (sort commands 'string-lessp))))
6264 (type . command)
6265 (requires-pattern . 2))
6266 "Source for completing and invoking Emacs commands.
6267 A command is a function with interactive spec that can
6268 be invoked with `M-x'.
6270 To get non-interactive functions listed, use
6271 `anything-c-source-emacs-functions'.")
6272 ;; (anything 'anything-c-source-emacs-commands)
6275 ;;; Anything M-x - Enhanced M-x UI
6278 ;; Another replacement of `M-x' that act exactly like the
6279 ;; vanilla Emacs one, no problem of windows configuration, prefix args
6280 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
6281 ;; anything invocation.
6282 ;; Documentation of commands available without quitting,
6283 ;; Show keybindings of commands.
6284 ;; Show history.
6285 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6286 "Return alist of MODE-MAP."
6287 (loop for key being the key-seqs of mode-map using (key-bindings com)
6288 for str-key = (key-description key)
6289 for ismenu = (string-match "<menu-bar>" str-key)
6290 unless ismenu collect (cons str-key com)))
6292 (defun anything-get-mode-map-from-mode (mode)
6293 "Guess the mode-map name according to MODE.
6294 Some modes don't use conventional mode-map name
6295 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6296 Return nil if no mode-map found."
6297 (loop
6298 ;; Start with a conventional mode-map name.
6299 with mode-map = (intern-soft (format "%s-map" mode))
6300 with mode-string = (symbol-name mode)
6301 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
6302 while (not mode-map)
6303 for count downfrom (length mode-name)
6304 ;; Return when no result after parsing entire string.
6305 when (eq count 0) return nil
6306 for sub-name = (substring mode-name 0 count)
6307 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6308 finally return mode-map))
6310 (defun anything-M-x-current-mode-map-alist ()
6311 "Return mode-map alist of current `major-mode'."
6312 (let ((map (anything-get-mode-map-from-mode major-mode)))
6313 (when (and map (boundp map))
6314 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6317 (defun anything-M-x-transformer (candidates sources)
6318 "filtered-candidate-transformer to show bindings in emacs commands.
6319 Show global bindings and local bindings according to current `major-mode'."
6320 (with-anything-current-buffer
6321 (loop
6322 with local-map = (anything-M-x-current-mode-map-alist)
6323 for cand in candidates
6324 for local-key = (car (rassq cand local-map))
6325 for key = (substitute-command-keys (format "\\[%s]" cand))
6326 collect
6327 (cons (cond ((and (string-match "^M-x" key) local-key)
6328 (format "%s (%s)"
6329 cand (propertize
6330 local-key
6331 'face 'anything-M-x-key-face)))
6332 ((string-match "^M-x" key) cand)
6333 (t (format "%s (%s)"
6334 cand (propertize
6336 'face 'anything-M-x-key-face)))) cand))))
6339 ;;; LaCarte
6340 (defvar anything-c-source-lacarte
6341 '((name . "Lacarte")
6342 (init . (lambda () (require 'lacarte )))
6343 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6344 (candidate-number-limit . 9999)
6345 (action . anything-c-call-interactively))
6346 "Needs lacarte.el.
6348 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6349 ;; (anything 'anything-c-source-lacarte)
6352 ;;;; <Function>
6353 ;;; Emacs functions
6356 (defvar anything-c-source-emacs-functions
6357 '((name . "Emacs Functions")
6358 (candidates . (lambda ()
6359 (let (commands)
6360 (mapatoms (lambda (a)
6361 (if (functionp a)
6362 (push (symbol-name a) commands))))
6363 (sort commands 'string-lessp))))
6364 (type . function)
6365 (requires-pattern . 2))
6366 "Source for completing Emacs functions.")
6367 ;; (anything 'anything-c-source-emacs-functions)
6369 ;;; With abbrev expansion
6370 ;;; Similar to my exec-abbrev-cmd.el
6371 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6372 (defvar anything-c-function-abbrev-regexp nil
6373 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6374 Regexp built from the current `anything-pattern' interpreting it
6375 as abbreviation.
6376 Only for internal use.")
6378 (defun anything-c-match-function-by-abbrev (candidate)
6379 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6381 Abbreviations are made by taking the first character from each
6382 word in the function's name, e.g. \"bb\" is an abbrev for
6383 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6384 (string-match anything-c-function-abbrev-regexp candidate))
6386 (defvar anything-c-source-emacs-functions-with-abbrevs
6387 (append anything-c-source-emacs-functions
6388 '((match anything-c-match-function-by-abbrev
6389 anything-c-string-match))
6390 '((init
6391 . (lambda ()
6392 (defadvice anything-update
6393 (before anything-c-update-function-abbrev-regexp activate)
6394 (let ((char-list (append anything-pattern nil))
6395 (str "^"))
6396 (dolist (c char-list)
6397 (setq str (concat str (list c) "[^-]*-")))
6398 (setq str (concat (substring str 0 (1- (length str))) "$"))
6399 (setq anything-c-function-abbrev-regexp str))))))))
6400 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
6402 (defvar anything-c-source-advice
6403 '((name . "Function Advice")
6404 (candidates . anything-c-advice-candidates)
6405 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6406 ;; (real-to-display . anything-c-advice-real-to-display)
6407 (persistent-action . anything-c-advice-persistent-action)
6408 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6409 ;; (anything 'anything-c-source-advice)
6410 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6411 ;; (testadvice)
6413 (defun anything-c-advice-candidates ()
6414 (require 'advice)
6415 (loop for (fname) in ad-advised-functions
6416 for function = (intern fname)
6417 append
6418 (loop for class in ad-advice-classes append
6419 (loop for advice in (ad-get-advice-info-field function class)
6420 for enabled = (ad-advice-enabled advice)
6421 collect
6422 (cons (format
6423 "%s %s %s"
6424 (if enabled "Enabled " "Disabled")
6425 (propertize fname 'face 'font-lock-function-name-face)
6426 (ad-make-single-advice-docstring advice class nil))
6427 (list function class advice))))))
6429 (defun anything-c-advice-persistent-action (func-class-advice)
6430 (if current-prefix-arg
6431 (anything-c-advice-toggle func-class-advice)
6432 (describe-function (car func-class-advice))))
6434 (defun anything-c-advice-toggle (func-class-advice)
6435 (destructuring-bind (function class advice) func-class-advice
6436 (cond ((ad-advice-enabled advice)
6437 (ad-advice-set-enabled advice nil)
6438 (message "Disabled"))
6439 (t ;disabled
6440 (ad-advice-set-enabled advice t)
6441 (message "Enabled")))
6442 (ad-activate function)
6443 (and anything-in-persistent-action
6444 (anything-c-advice-update-current-display-string))))
6446 (defun anything-c-advice-update-current-display-string ()
6447 (anything-edit-current-selection
6448 (let ((newword (cond ((looking-at "Disabled") "Enabled")
6449 ((looking-at "Enabled") "Disabled")))
6450 realvalue)
6451 (when newword
6452 (delete-region (point) (progn (forward-word 1) (point)))
6453 (insert newword)))))
6456 ;;;; <Variable>
6457 ;;; Emacs variables
6460 (defvar anything-c-source-emacs-variables
6461 '((name . "Emacs Variables")
6462 (candidates . (lambda ()
6463 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6464 (type . variable)
6465 (requires-pattern . 2))
6466 "Source for completing Emacs variables.")
6467 ;; (anything 'anything-c-source-emacs-variables)
6470 ;;; Bookmarks
6473 ;; Bind some faces for bookmarks.
6474 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6475 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6476 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6478 (eval-when-compile (require 'bookmark))
6479 (defvar anything-c-source-bookmarks
6480 '((name . "Bookmarks")
6481 (init . (lambda ()
6482 (require 'bookmark)))
6483 (candidates . bookmark-all-names)
6484 (type . bookmark))
6485 "See (info \"(emacs)Bookmarks\").")
6486 ;; (anything 'anything-c-source-bookmarks)
6488 ;;; bookmark-set
6489 (defvar anything-c-source-bookmark-set
6490 '((name . "Set Bookmark")
6491 (dummy)
6492 (action . bookmark-set))
6493 "See (info \"(emacs)Bookmarks\").")
6494 ;; (anything 'anything-c-source-bookmark-set)
6496 ;;; Visible Bookmarks
6497 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6500 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6501 (defvar anything-c-source-bm
6502 '((name . "Visible Bookmarks")
6503 (init . anything-c-bm-init)
6504 (candidates-in-buffer)
6505 (type . line))
6506 "Needs bm.el.
6508 http://www.nongnu.org/bm/")
6510 (defun anything-c-bm-init ()
6511 "Init function for `anything-c-source-bm'."
6512 (when (require 'bm nil t)
6513 (with-no-warnings
6514 (let ((bookmarks (bm-lists))
6515 (buf (anything-candidate-buffer 'global)))
6516 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6517 '< :key 'overlay-start))
6518 (let ((start (overlay-start bm))
6519 (end (overlay-end bm))
6520 (annotation (or (overlay-get bm 'annotation) "")))
6521 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6522 (let ((str (format "%5d: [%s]: %s\n"
6523 (line-number-at-pos start)
6524 annotation
6525 (buffer-substring start (1- end)))))
6526 (with-current-buffer buf (insert str))))))))))
6528 ;;; Special bookmarks
6529 (defvar anything-c-source-bookmarks-ssh
6530 '((name . "Bookmarks-ssh")
6531 (init . (lambda ()
6532 (require 'bookmark)))
6533 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6534 (type . bookmark))
6535 "See (info \"(emacs)Bookmarks\").")
6536 ;; (anything 'anything-c-source-bookmarks-ssh)
6538 (defvar anything-c-source-bookmarks-su
6539 '((name . "Bookmarks-root")
6540 (init . (lambda ()
6541 (require 'bookmark)))
6542 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6543 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6545 (type . bookmark))
6546 "See (info \"(emacs)Bookmarks\").")
6547 ;; (anything 'anything-c-source-bookmarks-su)
6549 (defvar anything-c-source-bookmarks-local
6550 '((name . "Bookmarks-Local")
6551 (init . (lambda ()
6552 (require 'bookmark)))
6553 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6554 (filtered-candidate-transformer
6555 anything-c-adaptive-sort
6556 anything-c-highlight-bookmark)
6557 (type . bookmark))
6558 "See (info \"(emacs)Bookmarks\").")
6559 ;; (anything 'anything-c-source-bookmarks-local)
6561 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6562 (let* ((lis-all (bookmark-all-names))
6563 (lis-loc (cond (local (loop for i in lis-all
6564 unless (string-match "^(ssh)\\|^(su)" i)
6565 collect i))
6566 (su (loop for i in lis-all
6567 when (string-match "^(su)" i)
6568 collect i))
6569 (sudo (loop for i in lis-all
6570 when (string-match "^(sudo)" i)
6571 collect i))
6572 (ssh (loop for i in lis-all
6573 when (string-match "^(ssh)" i)
6574 collect i)))))
6575 (sort lis-loc 'string-lessp)))
6577 (defun anything-c-bookmark-root-logged-p ()
6578 (catch 'break
6579 (dolist (i (mapcar #'buffer-name (buffer-list)))
6580 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6581 (throw 'break t)))))
6583 (defun anything-c-highlight-bookmark-su (files source)
6584 (if (anything-c-bookmark-root-logged-p)
6585 (anything-c-highlight-bookmark files source)
6586 (anything-c-highlight-not-logged files source)))
6588 (defun anything-c-highlight-not-logged (files source)
6589 (loop for i in files
6590 collect (propertize i 'face anything-c-bookmarks-face3)))
6592 (defun anything-c-highlight-bookmark (bookmarks source)
6593 "Used as `candidate-transformer' to colorize bookmarks.
6594 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6595 (loop for i in bookmarks
6596 for isfile = (bookmark-get-filename i)
6597 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6598 (bmkext-get-buffer-name i))
6599 for handlerp = (and (fboundp 'bookmark-get-handler)
6600 (bookmark-get-handler i))
6601 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6602 (bmkext-w3m-bookmark-p i))
6603 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6604 (bmkext-gnus-bookmark-p i))
6605 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6606 (bmkext-man-bookmark-p i))
6607 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6608 (bmkext-woman-bookmark-p i))
6609 for handlerp = (bookmark-get-handler i)
6610 for isannotation = (bookmark-get-annotation i)
6611 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6612 for isinfo = (eq handlerp 'Info-bookmark-jump)
6613 ;; Add a * if bookmark have annotation
6614 if (and isannotation (not (string-equal isannotation "")))
6615 do (setq i (concat "*" i))
6616 collect (cond (;; info buffers
6617 isinfo
6618 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6619 (;; w3m buffers
6620 isw3m
6621 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6622 (;; gnus buffers
6623 isgnus
6624 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6625 (;; Man Woman
6626 (or iswoman isman)
6627 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6628 (;; Addressbook
6629 isabook
6630 (propertize i 'face '((:foreground "Tomato"))))
6631 (;; directories
6632 (and isfile (file-directory-p isfile))
6633 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6634 (;; regular files
6636 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6640 ;;; Sources to filter bookmark-extensions bookmarks.
6643 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6644 ;; If you want to enable google-maps in addressbook you will need
6645 ;; Julien Danjou google-maps-el package available here:
6646 ;; http://julien.danjou.info/google-maps-el.html
6648 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6649 "Return a filtered `bookmark-alist' sorted alphabetically."
6650 (loop
6651 with alist = (if args
6652 (apply #'(lambda (x) (funcall fn x)) args)
6653 (funcall fn))
6654 for i in alist
6655 for b = (car i)
6656 collect b into sa
6657 finally return (sort sa 'string-lessp)))
6659 ;;; Addressbook.
6662 (defvar anything-c-source-bmkext-addressbook
6663 '((name . "Bookmark Addressbook")
6664 (init . (lambda ()
6665 (require 'bookmark-extensions)
6666 (bookmark-maybe-load-default-file)))
6667 (candidates . anything-c-bmkext-addressbook-setup-alist)
6668 (persistent-action
6669 . (lambda (candidate)
6670 (let ((bmk (anything-bookmark-get-bookmark-from-name
6671 candidate)))
6672 (bookmark--jump-via bmk 'pop-to-buffer))))
6673 (persistent-help . "Show contact - Prefix with C-u to append")
6674 (filtered-candidate-transformer
6675 anything-c-adaptive-sort
6676 anything-c-highlight-bookmark)
6677 (action . (("Show Contact(s)"
6678 . (lambda (candidate)
6679 (let* ((contacts (anything-marked-candidates))
6680 (current-prefix-arg (or anything-current-prefix-arg
6681 (> (length contacts) 1))))
6682 (bookmark-jump
6683 (anything-bookmark-get-bookmark-from-name (car contacts)))
6684 (anything-aif (cdr contacts)
6685 (loop for bmk in it do
6686 (bookmark-jump
6687 (anything-bookmark-get-bookmark-from-name bmk)))))))
6688 ("Send Mail"
6689 . (lambda (candidate)
6690 (let* ((contacts (anything-marked-candidates))
6691 (bmk (anything-bookmark-get-bookmark-from-name
6692 (car contacts)))
6693 (append (message-buffers)))
6694 (if append
6695 (addressbook-set-mail-buffer1 bmk 'append)
6696 (addressbook-set-mail-buffer1 bmk))
6697 (setq contacts (cdr contacts))
6698 (when contacts
6699 (loop for bmk in contacts do
6700 (addressbook-set-mail-buffer1 bmk 'append))))))
6701 ("Edit Bookmark"
6702 . (lambda (candidate)
6703 (let ((bmk (anything-bookmark-get-bookmark-from-name
6704 candidate)))
6705 (addressbook-bookmark-edit
6706 (assoc bmk bookmark-alist)))))
6707 ("Insert Email at point"
6708 . (lambda (candidate)
6709 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6710 candidate))
6711 (mlist (split-string
6712 (assoc-default
6713 'email (assoc bmk bookmark-alist))
6714 ", ")))
6715 (insert
6716 (if (> (length mlist) 1)
6717 (anything-comp-read
6718 "Insert Mail Address: " mlist :must-match t)
6719 (car mlist))))))
6720 ("Show annotation"
6721 . (lambda (candidate)
6722 (let ((bmk (anything-bookmark-get-bookmark-from-name
6723 candidate)))
6724 (bookmark-show-annotation bmk))))
6725 ("Edit annotation"
6726 . (lambda (candidate)
6727 (let ((bmk (anything-bookmark-get-bookmark-from-name
6728 candidate)))
6729 (bookmark-edit-annotation bmk))))
6730 ("Show Google map"
6731 . (lambda (candidate)
6732 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6733 candidate))
6734 (full-bmk (assoc bmk bookmark-alist)))
6735 (addressbook-google-map full-bmk))))))))
6738 (defun anything-c-bmkext-addressbook-setup-alist ()
6739 "Specialized filter function for bookmarks w3m."
6740 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6742 ;; W3m bookmarks from bookmark-extensions.
6743 (defvar anything-c-source-bookmark-w3m
6744 '((name . "Bookmark W3m")
6745 (init . (lambda ()
6746 (require 'bookmark-extensions)
6747 (bookmark-maybe-load-default-file)))
6748 (candidates . anything-c-bookmark-w3m-setup-alist)
6749 (filtered-candidate-transformer
6750 anything-c-adaptive-sort
6751 anything-c-highlight-bookmark)
6752 (type . bookmark)))
6753 ;; (anything 'anything-c-source-bookmark-w3m)
6755 (defun anything-c-bookmark-w3m-setup-alist ()
6756 "Specialized filter function for bookmarks w3m."
6757 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6759 ;; Images
6760 (defvar anything-c-source-bookmark-images
6761 '((name . "Bookmark Images")
6762 (init . (lambda ()
6763 (require 'bookmark-extensions)
6764 (bookmark-maybe-load-default-file)))
6765 (candidates . anything-c-bookmark-images-setup-alist)
6766 (filtered-candidate-transformer
6767 anything-c-adaptive-sort
6768 anything-c-highlight-bookmark)
6769 (type . bookmark)))
6770 ;; (anything 'anything-c-source-bookmark-images)
6772 (defun anything-c-bookmark-images-setup-alist ()
6773 "Specialized filter function for images bookmarks."
6774 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6776 ;; Woman Man
6777 (defvar anything-c-source-bookmark-man
6778 '((name . "Bookmark Woman&Man")
6779 (init . (lambda ()
6780 (require 'bookmark-extensions)
6781 (bookmark-maybe-load-default-file)))
6782 (candidates . anything-c-bookmark-man-setup-alist)
6783 (filtered-candidate-transformer
6784 anything-c-adaptive-sort
6785 anything-c-highlight-bookmark)
6786 (type . bookmark)))
6787 ;; (anything 'anything-c-source-bookmark-man)
6789 (defun anything-c-bookmark-man-setup-alist ()
6790 "Specialized filter function for bookmarks w3m."
6791 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6792 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6794 ;; Gnus
6795 (defvar anything-c-source-bookmark-gnus
6796 '((name . "Bookmark Gnus")
6797 (init . (lambda ()
6798 (require 'bookmark-extensions)
6799 (bookmark-maybe-load-default-file)))
6800 (candidates . anything-c-bookmark-gnus-setup-alist)
6801 (filtered-candidate-transformer
6802 anything-c-adaptive-sort
6803 anything-c-highlight-bookmark)
6804 (type . bookmark)))
6805 ;; (anything 'anything-c-source-bookmark-gnus)
6807 (defun anything-c-bookmark-gnus-setup-alist ()
6808 "Specialized filter function for bookmarks gnus."
6809 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6811 ;; Info
6812 (defvar anything-c-source-bookmark-info
6813 '((name . "Bookmark Info")
6814 (init . (lambda ()
6815 (require 'bookmark-extensions)
6816 (bookmark-maybe-load-default-file)))
6817 (candidates . anything-c-bookmark-info-setup-alist)
6818 (filtered-candidate-transformer
6819 anything-c-adaptive-sort
6820 anything-c-highlight-bookmark)
6821 (type . bookmark)))
6822 ;; (anything 'anything-c-source-bookmark-info)
6824 (defun anything-c-bookmark-info-setup-alist ()
6825 "Specialized filter function for bookmarks info."
6826 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6828 ;; Local Files&directories
6829 (defvar anything-c-source-bookmark-files&dirs
6830 '((name . "Bookmark Files&Directories")
6831 (init . (lambda ()
6832 (require 'bookmark-extensions)
6833 (bookmark-maybe-load-default-file)))
6834 (candidates . anything-c-bookmark-local-files-setup-alist)
6835 (filtered-candidate-transformer
6836 anything-c-adaptive-sort
6837 anything-c-highlight-bookmark)
6838 (type . bookmark)))
6839 ;; (anything 'anything-c-source-bookmark-files&dirs)
6841 (defun anything-c-bookmark-local-files-setup-alist ()
6842 "Specialized filter function for bookmarks locals files."
6843 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6845 ;; Su Files&directories
6846 (defvar anything-c-source-bookmark-su-files&dirs
6847 '((name . "Bookmark Root-Files&Directories")
6848 (init . (lambda ()
6849 (require 'bookmark-extensions)
6850 (bookmark-maybe-load-default-file)))
6851 (candidates . anything-c-bookmark-su-files-setup-alist)
6852 (filtered-candidate-transformer
6853 anything-c-adaptive-sort
6854 anything-c-highlight-bookmark-su)
6855 (type . bookmark)))
6856 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6858 (defun anything-c-bookmark-su-files-setup-alist ()
6859 "Specialized filter function for bookmarks su/sudo files."
6860 (declare (special bmkext-su-or-sudo-regexp))
6861 (loop
6862 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6863 for i in l
6864 for isfile = (bookmark-get-filename i)
6865 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6866 (save-match-data
6867 (string-match tramp-file-name-regexp isfile)))
6868 for issu = (and istramp
6869 (string-match bmkext-su-or-sudo-regexp isfile))
6870 if issu
6871 collect i))
6873 ;; Ssh Files&directories
6874 (defvar anything-c-source-bookmark-ssh-files&dirs
6875 '((name . "Bookmark Ssh-Files&Directories")
6876 (init . (lambda ()
6877 (require 'bookmark-extensions)
6878 (bookmark-maybe-load-default-file)))
6879 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6880 (filtered-candidate-transformer . anything-c-adaptive-sort)
6881 (type . bookmark)))
6882 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6884 (defun anything-c-bookmark-ssh-files-setup-alist ()
6885 "Specialized filter function for bookmarks ssh files."
6886 (loop
6887 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6888 for i in l
6889 for isfile = (bookmark-get-filename i)
6890 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6891 (save-match-data
6892 (string-match tramp-file-name-regexp isfile)))
6893 for isssh = (and istramp
6894 (string-match "/ssh:" isfile))
6895 if isssh
6896 collect i))
6900 ;;; Firefox bookmarks
6903 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6904 ;; (only for firefox versions >=3)
6905 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6906 ;; to true:
6907 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6908 ;; You should have now:
6909 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6911 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6912 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6914 (defun anything-get-firefox-user-init-dir ()
6915 "Guess the default Firefox user directory name."
6916 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6917 (moz-user-dir
6918 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6919 (goto-char (point-min))
6920 (prog1
6921 (when (search-forward "Path=" nil t)
6922 (buffer-substring-no-properties (point) (point-at-eol)))
6923 (kill-buffer)))))
6924 (file-name-as-directory (concat moz-dir moz-user-dir))))
6926 (defun anything-guess-firefox-bookmark-file ()
6927 "Return the path of the Firefox bookmarks file."
6928 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6930 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6931 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6932 (let (bookmarks-alist url title)
6933 (with-temp-buffer
6934 (insert-file-contents file)
6935 (goto-char (point-min))
6936 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6937 (forward-line 0)
6938 (when (re-search-forward url-regexp nil t)
6939 (setq url (match-string 0)))
6940 (when (re-search-forward bmk-regexp nil t)
6941 (setq title (match-string 1)))
6942 (push (cons title url) bookmarks-alist)
6943 (forward-line)))
6944 (nreverse bookmarks-alist)))
6946 (defvar anything-c-firefox-bookmarks-alist nil)
6947 (defvar anything-c-source-firefox-bookmarks
6948 '((name . "Firefox Bookmarks")
6949 (init . (lambda ()
6950 (setq anything-c-firefox-bookmarks-alist
6951 (anything-html-bookmarks-to-alist
6952 (anything-guess-firefox-bookmark-file)
6953 anything-firefox-bookmark-url-regexp
6954 anything-firefox-bookmarks-regexp))))
6955 (candidates . (lambda ()
6956 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6957 (filtered-candidate-transformer
6958 anything-c-adaptive-sort
6959 anything-c-highlight-firefox-bookmarks)
6960 (action . (("Browse Url Firefox"
6961 . (lambda (candidate)
6962 (browse-url-firefox
6963 (anything-c-firefox-bookmarks-get-value candidate))))
6964 ("Browse Url w3m"
6965 . (lambda (candidate)
6966 (w3m-browse-url
6967 (anything-c-firefox-bookmarks-get-value candidate))))
6968 ("Copy Url"
6969 . (lambda (elm)
6970 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6972 ;; (anything 'anything-c-source-firefox-bookmarks)
6974 (defun anything-c-firefox-bookmarks-get-value (elm)
6975 (assoc-default elm anything-c-firefox-bookmarks-alist))
6977 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6978 (loop for i in bookmarks
6979 collect (propertize
6980 i 'face '((:foreground "YellowGreen"))
6981 'help-echo (anything-c-firefox-bookmarks-get-value i))))
6985 ;;; W3m bookmark - anything interface.
6988 ;; Some users have the emacs-w3m library in load-path
6989 ;; without having the w3m executable :-;
6990 ;; So check if w3m program is present before trying to load
6991 ;; emacs-w3m.
6992 (eval-when-compile
6993 (when (executable-find "w3m")
6994 (require 'w3m-bookmark nil t)))
6996 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6997 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6998 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6999 (defvar anything-c-w3m-bookmarks-alist nil)
7000 (defvar anything-c-source-w3m-bookmarks
7001 '((name . "W3m Bookmarks")
7002 (init . (lambda ()
7003 (setq anything-c-w3m-bookmarks-alist
7004 (anything-html-bookmarks-to-alist
7005 w3m-bookmark-file
7006 anything-w3m-bookmark-url-regexp
7007 anything-w3m-bookmarks-regexp))))
7008 (candidates . (lambda ()
7009 (mapcar #'car anything-c-w3m-bookmarks-alist)))
7010 (filtered-candidate-transformer
7011 anything-c-adaptive-sort
7012 anything-c-highlight-w3m-bookmarks)
7013 (action . (("Browse Url"
7014 . (lambda (candidate)
7015 (anything-c-w3m-browse-bookmark candidate)))
7016 ("Copy Url"
7017 . (lambda (elm)
7018 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
7019 ("Browse Url Firefox"
7020 . (lambda (candidate)
7021 (anything-c-w3m-browse-bookmark candidate t)))
7022 ("Delete Bookmark"
7023 . (lambda (candidate)
7024 (anything-c-w3m-delete-bookmark candidate)))
7025 ("Rename Bookmark"
7026 . (lambda (candidate)
7027 (anything-c-w3m-rename-bookmark candidate)))))
7028 (persistent-action . (lambda (candidate)
7029 (if current-prefix-arg
7030 (anything-c-w3m-browse-bookmark candidate t)
7031 (anything-c-w3m-browse-bookmark candidate nil t))))
7032 (persistent-help . "Open URL with emacs-w3m in new tab / \
7033 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
7034 "Needs w3m and emacs-w3m.
7036 http://w3m.sourceforge.net/
7037 http://emacs-w3m.namazu.org/")
7039 ;; (anything 'anything-c-source-w3m-bookmarks)
7041 (defun anything-c-w3m-bookmarks-get-value (elm)
7042 (replace-regexp-in-string
7043 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
7045 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
7046 (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
7047 (arg (and (eq fn 'w3m-browse-url) new-tab)))
7048 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
7050 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
7051 (loop for i in bookmarks
7052 collect (propertize
7053 i 'face 'anything-w3m-bookmarks-face
7054 'help-echo (anything-c-w3m-bookmarks-get-value i))))
7057 (defun anything-c-w3m-delete-bookmark (elm)
7058 "Delete w3m bookmark from `w3m-bookmark-file'."
7059 (with-current-buffer
7060 (find-file-literally w3m-bookmark-file)
7061 (goto-char (point-min))
7062 (when (re-search-forward elm nil t)
7063 (beginning-of-line)
7064 (delete-region (point)
7065 (line-end-position))
7066 (delete-blank-lines))
7067 (save-buffer)
7068 (kill-buffer)))
7070 (defun anything-c-w3m-rename-bookmark (elm)
7071 "Rename w3m bookmark in `w3m-bookmark-file'."
7072 (let* ((old-title (replace-regexp-in-string ">" "" elm))
7073 (new-title (read-string "NewTitle: " old-title)))
7074 (with-current-buffer
7075 (find-file-literally w3m-bookmark-file)
7076 (goto-char (point-min))
7077 (when (re-search-forward (concat elm "<") nil t)
7078 (goto-char (1- (point)))
7079 (delete-char (- (length old-title)))
7080 (insert new-title))
7081 (save-buffer)
7082 (kill-buffer))))
7085 ;;;; <Library>
7086 ;;; Elisp library scan
7089 (defvar anything-c-source-elisp-library-scan
7090 '((name . "Elisp libraries (Scan)")
7091 (init . (anything-c-elisp-library-scan-init))
7092 (candidates-in-buffer)
7093 (action ("Find library"
7094 . (lambda (candidate) (find-file (find-library-name candidate))))
7095 ("Find library other window"
7096 . (lambda (candidate)
7097 (find-file-other-window (find-library-name candidate))))
7098 ("Load library"
7099 . (lambda (candidate) (load-library candidate))))))
7100 ;; (anything 'anything-c-source-elisp-library-scan)
7102 (defun anything-c-elisp-library-scan-init ()
7103 "Init anything buffer status."
7104 (let ((anything-buffer (anything-candidate-buffer 'global))
7105 (library-list (anything-c-elisp-library-scan-list)))
7106 (with-current-buffer anything-buffer
7107 (dolist (library library-list)
7108 (insert (format "%s\n" library))))))
7110 (defun anything-c-elisp-library-scan-list (&optional dirs string)
7111 "Do completion for file names passed to `locate-file'.
7112 DIRS is directory to search path.
7113 STRING is string to match."
7114 ;; Use `load-path' as path when ignore `dirs'.
7115 (or dirs (setq dirs load-path))
7116 ;; Init with blank when ignore `string'.
7117 (or string (setq string ""))
7118 ;; Get library list.
7119 (let ((string-dir (file-name-directory string))
7120 ;; File regexp that suffix match `load-file-rep-suffixes'.
7121 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
7122 name
7123 names)
7124 (dolist (dir dirs)
7125 (unless dir
7126 (setq dir default-directory))
7127 (if string-dir
7128 (setq dir (expand-file-name string-dir dir)))
7129 (when (file-directory-p dir)
7130 (dolist (file (file-name-all-completions
7131 (file-name-nondirectory string) dir))
7132 ;; Suffixes match `load-file-rep-suffixes'.
7133 (setq name (if string-dir (concat string-dir file) file))
7134 (if (string-match match-regexp name)
7135 (add-to-list 'names name)))))
7136 names))
7139 ;;;; <Programming>
7143 ;;; Imenu
7146 (defvar anything-c-imenu-delimiter " / ")
7148 (defvar anything-c-imenu-index-filter nil)
7149 (make-variable-buffer-local 'anything-c-imenu-index-filter)
7151 (defvar anything-c-cached-imenu-alist nil)
7152 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
7154 (defvar anything-c-cached-imenu-candidates nil)
7155 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
7157 (defvar anything-c-cached-imenu-tick nil)
7158 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
7160 (eval-when-compile (require 'imenu))
7161 (setq imenu-auto-rescan t)
7163 (defun anything-imenu-create-candidates (entry)
7164 "Create candidates with ENTRY."
7165 (if (listp (cdr entry))
7166 (mapcan
7167 (lambda (sub)
7168 (if (consp (cdr sub))
7169 (mapcar
7170 (lambda (subentry)
7171 (concat (car entry) anything-c-imenu-delimiter subentry))
7172 (anything-imenu-create-candidates sub))
7173 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
7174 (cdr entry))
7175 (list entry)))
7177 (defvar anything-c-source-imenu
7178 '((name . "Imenu")
7179 (init . (lambda () (require 'imenu)))
7180 (candidates . anything-c-imenu-candidates)
7181 (persistent-action . (lambda (elm)
7182 (anything-c-imenu-default-action elm)
7183 (unless (fboundp 'semantic-imenu-tag-overlay)
7184 (anything-match-line-color-current-line))))
7185 (persistent-help . "Show this entry")
7186 (action . anything-c-imenu-default-action))
7187 "See (info \"(emacs)Imenu\")")
7189 ;; (anything 'anything-c-source-imenu)
7191 (defun anything-c-imenu-candidates ()
7192 (with-anything-current-buffer
7193 (let ((tick (buffer-modified-tick)))
7194 (if (eq anything-c-cached-imenu-tick tick)
7195 anything-c-cached-imenu-candidates
7196 (setq imenu--index-alist nil)
7197 (setq anything-c-cached-imenu-tick tick
7198 anything-c-cached-imenu-candidates
7199 (ignore-errors
7200 (mapcan
7201 'anything-imenu-create-candidates
7202 (setq anything-c-cached-imenu-alist
7203 (let ((index (imenu--make-index-alist)))
7204 (if anything-c-imenu-index-filter
7205 (funcall anything-c-imenu-index-filter index)
7206 index))))))
7207 (setq anything-c-cached-imenu-candidates
7208 (mapcar #'(lambda (x)
7209 (if (stringp x)
7211 (car x)))
7212 anything-c-cached-imenu-candidates))))))
7214 (setq imenu-default-goto-function 'imenu-default-goto-function)
7215 (defun anything-c-imenu-default-action (elm)
7216 "The default action for `anything-c-source-imenu'."
7217 (let ((path (split-string elm anything-c-imenu-delimiter))
7218 (alist anything-c-cached-imenu-alist))
7219 (dolist (elm path)
7220 (setq alist (assoc elm alist)))
7221 (imenu alist)))
7225 ;;; Ctags
7228 (defvar anything-c-ctags-modes
7229 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
7230 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
7231 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
7233 (defun anything-c-source-ctags-init ()
7234 (when (and buffer-file-name
7235 (memq major-mode anything-c-ctags-modes)
7236 (anything-current-buffer-is-modified))
7237 (with-current-buffer (anything-candidate-buffer 'local)
7238 (call-process-shell-command
7239 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
7240 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
7241 anything-buffer-file-name)
7242 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
7243 nil (current-buffer))
7244 (goto-char (point-min))
7245 (forward-line 2)
7246 (delete-region (point-min) (point))
7247 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
7248 for lineno-start = (point)
7249 for lineno = (buffer-substring
7250 lineno-start
7251 (1- (search-forward "," (point-at-eol) t)))
7253 (beginning-of-line)
7254 (insert (format "%5s:" lineno))
7255 (search-forward "\177" (point-at-eol) t)
7256 (delete-region (1- (point)) (point-at-eol))
7257 (forward-line 1)))))
7259 (defvar anything-c-source-ctags
7260 '((name . "Exuberant ctags")
7261 (init . anything-c-source-ctags-init)
7262 (candidates-in-buffer)
7263 (adjust)
7264 (type . line))
7265 "Needs Exuberant Ctags.
7267 http://ctags.sourceforge.net/")
7268 ;; (anything 'anything-c-source-ctags)
7271 ;;; Etags
7274 ;; anything-etags.el is deprecated, if this file is found,
7275 ;; warn user at compile time.
7276 (eval-when-compile
7277 (when (locate-library "anything-etags.el")
7278 (display-warning
7279 '(anything-config)
7280 "You are using obsolete library `anything-etags.el' and should remove it."
7281 :warning)))
7283 (defvar anything-c-etags-tag-file-dir nil
7284 "Etags file directory.")
7285 (defvar anything-c-etags-mtime-alist nil
7286 "Store the last modification time of etags files here.")
7287 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
7288 "Cache content of etags files used here for faster access.")
7290 (defun anything-c-etags-get-tag-file (&optional directory)
7291 "Return the path of etags file if found."
7292 ;; Get tag file from `default-directory' or upper directory.
7293 (let ((current-dir (anything-c-etags-find-tag-file-directory
7294 (or directory default-directory))))
7295 ;; Return nil if not find tag file.
7296 (when current-dir
7297 ;; Set tag file directory.
7298 (setq anything-c-etags-tag-file-dir current-dir)
7299 (expand-file-name anything-c-etags-tag-file-name current-dir))))
7301 (defun anything-c-etags-find-tag-file-directory (current-dir)
7302 "Try to find the directory containing tag file.
7303 If not found in CURRENT-DIR search in upper directory."
7304 (flet ((file-exists? (dir)
7305 (let ((tag-path (expand-file-name
7306 anything-c-etags-tag-file-name dir)))
7307 (and (stringp tag-path)
7308 (file-exists-p tag-path)
7309 (file-readable-p tag-path)))))
7310 (loop with count = 0
7311 until (file-exists? current-dir)
7312 ;; Return nil if outside the value of
7313 ;; `anything-c-etags-tag-file-search-limit'.
7314 if (= count anything-c-etags-tag-file-search-limit)
7315 do (return nil)
7316 ;; Or search upper directories.
7317 else
7318 do (incf count)
7319 (setq current-dir (expand-file-name (concat current-dir "../")))
7320 finally return current-dir)))
7322 (defun anything-c-source-etags-header-name (x)
7323 "Create header name for this anything etags session."
7324 (concat "Etags in "
7325 (with-anything-current-buffer
7326 (anything-c-etags-get-tag-file))))
7328 (defmacro anything-c-etags-create-buffer (file)
7329 "Create the `anything-buffer' based on contents of etags tag FILE."
7330 `(let* ((tag-fname ,file)
7332 (split (with-current-buffer (find-file-noselect tag-fname)
7333 (prog1
7334 (split-string (buffer-string) "\n" 'omit-nulls)
7335 (setq max (line-number-at-pos (point-max)))
7336 (kill-buffer))))
7337 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
7338 (loop
7339 with fname
7340 with cand
7341 for i in split for count from 0
7342 for elm = (unless (string-match "^\x0c" i)
7343 (anything-aif (string-match "\177" i)
7344 (substring i 0 it)
7346 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
7347 (setq fname (match-string 1 elm)))
7348 (elm (setq cand (concat fname ": " elm)))
7349 (t (setq cand nil)))
7350 when cand do (progn
7351 (insert (concat cand "\n"))
7352 (progress-reporter-update progress-reporter count)))))
7354 (defun anything-c-etags-init ()
7355 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
7356 If no entry in cache, create one."
7357 (let ((tagfile (anything-c-etags-get-tag-file)))
7358 (when tagfile
7359 (with-current-buffer (anything-candidate-buffer 'global)
7360 (anything-aif (gethash tagfile anything-c-etags-cache)
7361 ;; An entry is present in cache, insert it.
7362 (insert it)
7363 ;; No entry, create a new buffer using content of tag file (slower).
7364 (anything-c-etags-create-buffer tagfile)
7365 ;; Store content of buffer in cache.
7366 (puthash tagfile (buffer-string) anything-c-etags-cache)
7367 ;; Store or set the last modification of tag file.
7368 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
7369 ;; If an entry exists modify it.
7370 (setcdr it (anything-c-etags-mtime tagfile))
7371 ;; No entry create a new one.
7372 (add-to-list 'anything-c-etags-mtime-alist
7373 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
7375 (defvar anything-c-source-etags-select
7376 '((name . "Etags")
7377 (header-name . anything-c-source-etags-header-name)
7378 (init . anything-c-etags-init)
7379 (candidates-in-buffer)
7380 (mode-line . anything-etags-mode-line-string)
7381 (action . anything-c-etags-default-action)
7382 (persistent-action . (lambda (candidate)
7383 (anything-c-etags-default-action candidate)
7384 (anything-match-line-color-current-line))))
7385 "Anything source for Etags.")
7387 (defun anything-c-etags-default-action (candidate)
7388 "Anything default action to jump to an etags entry."
7389 (let* ((split (split-string candidate ": "))
7390 (fname (expand-file-name
7391 (car split) anything-c-etags-tag-file-dir))
7392 (elm (cadr split)))
7393 (find-file fname)
7394 (goto-char (point-min))
7395 (search-forward elm nil t)
7396 (goto-char (match-beginning 0))))
7398 (defun anything-c-etags-mtime (file)
7399 "Last modification time of etags tag FILE."
7400 (cadr (nth 5 (file-attributes file))))
7402 (defun anything-c-etags-file-modified-p (file)
7403 "Check if tag FILE have been modified in this session.
7404 If FILE is nil return nil."
7405 (let ((last-modif (and file
7406 (assoc-default file anything-c-etags-mtime-alist))))
7407 (and last-modif
7408 (/= last-modif (anything-c-etags-mtime file)))))
7412 ;;; Semantic
7415 (defvar anything-semantic-candidates nil)
7417 (defun anything-semantic-construct-candidates (tags depth)
7418 (when (require 'semantic nil t)
7419 (apply
7420 'append
7421 (mapcar
7422 (lambda (tag)
7423 (if (listp tag)
7424 (let ((type (semantic-tag-type tag))
7425 (class (semantic-tag-class tag)))
7426 (if (or (and (stringp type)
7427 (or (string= type "class")
7428 (string= type "namespace")))
7429 (eq class 'function)
7430 (eq class 'variable))
7431 (cons (cons (concat (make-string (* depth 2) ?\s)
7432 (semantic-format-tag-summarize tag nil t))
7433 tag)
7434 (anything-semantic-construct-candidates
7435 (semantic-tag-components tag) (1+ depth)))))))
7436 tags))))
7438 (defun anything-semantic-default-action (candidate)
7439 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7440 (semantic-go-to-tag tag)))
7442 (defvar anything-c-source-semantic
7443 '((name . "Semantic Tags")
7444 (init . (lambda ()
7445 (setq anything-semantic-candidates
7446 (ignore-errors (anything-semantic-construct-candidates
7447 (semantic-fetch-tags) 0)))))
7448 (candidates . (lambda ()
7449 (if anything-semantic-candidates
7450 (mapcar 'car anything-semantic-candidates))))
7451 (persistent-action . (lambda (elm)
7452 (anything-semantic-default-action elm)
7453 (anything-match-line-color-current-line)))
7454 (persistent-help . "Show this entry")
7455 (action . anything-semantic-default-action)
7456 "Needs semantic in CEDET.
7458 http://cedet.sourceforge.net/semantic.shtml
7459 http://cedet.sourceforge.net/"))
7461 ;; (anything 'anything-c-source-semantic)
7464 ;;; Anything interface of `simple-call-tree.el'.
7466 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el>
7468 ;; Function is called by
7469 (defvar anything-c-source-simple-call-tree-functions-callers
7470 '((name . "Function is called by")
7471 (init . anything-c-simple-call-tree-functions-callers-init)
7472 (multiline)
7473 (candidates . anything-c-simple-call-tree-candidates)
7474 (persistent-action . anything-c-simple-call-tree-persistent-action)
7475 (persistent-help . "Show function definitions by rotation")
7476 (action ("Find definition selected by persistent-action" .
7477 anything-c-simple-call-tree-find-definition)))
7478 "Needs simple-call-tree.el.
7479 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7481 (defvar anything-c-simple-call-tree-tick nil)
7482 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7483 (defun anything-c-simple-call-tree-analyze-maybe ()
7484 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7485 (simple-call-tree-analyze)
7486 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7488 (defun anything-c-simple-call-tree-init-base (function message)
7489 (require 'simple-call-tree)
7490 (with-no-warnings
7491 (when (anything-current-buffer-is-modified)
7492 (anything-c-simple-call-tree-analyze-maybe)
7493 (let ((list (funcall function simple-call-tree-alist)))
7494 (with-current-buffer (anything-candidate-buffer 'local)
7495 (dolist (entry list)
7496 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
7497 (insert (car entry) message
7498 (if (string= funcs " ")
7499 " no functions."
7500 funcs)
7501 "\n\n"))))))))
7503 (defun anything-c-simple-call-tree-functions-callers-init ()
7504 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7505 " is called by\n"))
7507 (defun anything-c-simple-call-tree-candidates ()
7508 (with-current-buffer (anything-candidate-buffer)
7509 (split-string (buffer-string) "\n\n")))
7511 (defvar anything-c-simple-call-tree-related-functions nil)
7512 (defvar anything-c-simple-call-tree-function-index 0)
7513 (defun anything-c-simple-call-tree-persistent-action (candidate)
7514 (unless (eq last-command 'anything-execute-persistent-action)
7515 (setq anything-c-simple-call-tree-related-functions
7516 (delete "no functions."
7517 (split-string
7518 (replace-regexp-in-string " \\| is called by\\| calls "
7519 "" candidate)
7520 "\n")))
7521 (setq anything-c-simple-call-tree-function-index -1))
7522 (incf anything-c-simple-call-tree-function-index)
7523 (anything-c-simple-call-tree-find-definition candidate))
7525 (defun anything-c-simple-call-tree-find-definition (candidate)
7526 (find-function
7527 (intern
7528 (nth (mod anything-c-simple-call-tree-function-index
7529 (length anything-c-simple-call-tree-related-functions))
7530 anything-c-simple-call-tree-related-functions))))
7532 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
7534 ;;; Function calls
7535 (defvar anything-c-source-simple-call-tree-callers-functions
7536 '((name . "Function calls")
7537 (init . anything-c-simple-call-tree-callers-functions-init)
7538 (multiline)
7539 (candidates . anything-c-simple-call-tree-candidates)
7540 (persistent-action . anything-c-simple-call-tree-persistent-action)
7541 (persistent-help . "Show function definitions by rotation")
7542 (action ("Find definition selected by persistent-action" .
7543 anything-c-simple-call-tree-find-definition)))
7544 "Needs simple-call-tree.el.
7545 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7547 (defun anything-c-simple-call-tree-callers-functions-init ()
7548 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7550 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
7554 ;;; Anything UI of auto-document.el
7556 ;; <http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el>
7558 ;; Commands/Options with doc
7559 (defvar anything-c-auto-document-data nil)
7560 (make-variable-buffer-local 'anything-c-auto-document-data)
7561 (defvar anything-c-source-commands-and-options-in-file
7562 '((name . "Commands/Options in file")
7563 (header-name
7564 . (lambda (x) (format "Commands/Options in %s"
7565 (buffer-local-value 'buffer-file-name
7566 anything-current-buffer))))
7567 (candidates . anything-command-and-options-candidates)
7568 (multiline)
7569 (action . imenu))
7570 "List Commands and Options with doc. It needs auto-document.el .
7572 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7574 (eval-when-compile (require 'auto-document nil t))
7575 (defun anything-command-and-options-candidates ()
7576 (with-anything-current-buffer
7577 (when (and (require 'auto-document nil t)
7578 (eq major-mode 'emacs-lisp-mode)
7579 (or (anything-current-buffer-is-modified)
7580 (not anything-c-auto-document-data)))
7581 (or imenu--index-alist (imenu--make-index-alist t))
7582 (setq anything-c-auto-document-data
7583 (destructuring-bind (commands options)
7584 (adoc-construct anything-current-buffer)
7585 (append
7586 (loop for (command . doc) in commands
7587 for cmdname = (symbol-name command)
7588 collect
7589 (cons
7590 (format "Command: %s\n %s"
7591 (propertize cmdname 'face font-lock-function-name-face)
7592 (adoc-first-line doc))
7593 (assoc cmdname imenu--index-alist)))
7594 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7595 for (option doc default) in options
7596 for optname = (symbol-name option)
7597 collect
7598 (cons
7599 (format "Option: %s\n %s\n default = %s"
7600 (propertize optname 'face font-lock-variable-name-face)
7601 (adoc-first-line doc)
7602 (adoc-prin1-to-string default))
7603 (assoc optname
7604 var-alist)))))))
7605 anything-c-auto-document-data))
7607 ;; (anything 'anything-c-source-commands-and-options-in-file)
7610 ;;;; <Color and Face>
7613 ;;; Customize Face
7616 (defvar anything-c-source-customize-face
7617 '((name . "Customize Face")
7618 (init . (lambda ()
7619 (unless (anything-candidate-buffer)
7620 (save-window-excursion (list-faces-display))
7621 (anything-candidate-buffer (get-buffer "*Faces*")))))
7622 (candidates-in-buffer)
7623 (get-line . buffer-substring)
7624 (action . (lambda (line)
7625 (customize-face (intern (car (split-string line))))))
7626 (requires-pattern . 3))
7627 "See (info \"(emacs)Faces\")")
7628 ;; (anything 'anything-c-source-customize-face)
7630 ;;; Colors browser
7633 (defvar anything-c-source-colors
7634 '((name . "Colors")
7635 (init . (lambda () (unless (anything-candidate-buffer)
7636 (save-window-excursion (list-colors-display))
7637 (anything-candidate-buffer (get-buffer "*Colors*")))))
7638 (candidates-in-buffer)
7639 (get-line . buffer-substring)
7640 (action
7641 ("Copy Name" . (lambda (candidate)
7642 (kill-new (anything-c-colors-get-name candidate))))
7643 ("Copy RGB" . (lambda (candidate)
7644 (kill-new (anything-c-colors-get-rgb candidate))))
7645 ("Insert Name" . (lambda (candidate)
7646 (with-anything-current-buffer
7647 (insert (anything-c-colors-get-name candidate)))))
7648 ("Insert RGB" . (lambda (candidate)
7649 (with-anything-current-buffer
7650 (insert (anything-c-colors-get-rgb candidate))))))))
7651 ;; (anything 'anything-c-source-colors)
7653 (defun anything-c-colors-get-name (candidate)
7654 "Get color name."
7655 (replace-regexp-in-string
7656 " " ""
7657 (with-temp-buffer
7658 (insert (capitalize candidate))
7659 (goto-char (point-min))
7660 (search-forward-regexp "\\s-\\{2,\\}")
7661 (delete-region (point) (point-max))
7662 (buffer-string))))
7664 (defun anything-c-colors-get-rgb (candidate)
7665 "Get color RGB."
7666 (replace-regexp-in-string
7667 " " ""
7668 (with-temp-buffer
7669 (insert (capitalize candidate))
7670 (goto-char (point-max))
7671 (search-backward-regexp "\\s-\\{2,\\}")
7672 (delete-region (point) (point-min))
7673 (buffer-string))))
7676 ;;;; <Search Engine>
7677 ;;; Tracker desktop search
7678 (defvar anything-c-source-tracker-search
7679 '((name . "Tracker Search")
7680 (candidates . (lambda ()
7681 (start-process "tracker-search-process" nil
7682 "tracker-search"
7683 anything-pattern)))
7684 (type . file)
7685 (requires-pattern . 3)
7686 (delayed))
7687 "Source for retrieving files matching the current input pattern
7688 with the tracker desktop search.")
7689 ;; (anything 'anything-c-source-tracker-search)
7691 ;;; Spotlight (MacOS X desktop search)
7692 (defvar anything-c-source-mac-spotlight
7693 '((name . "mdfind")
7694 (candidates
7695 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7696 (type . file)
7697 (requires-pattern . 3)
7698 (delayed))
7699 "Source for retrieving files via Spotlight's command line
7700 utility mdfind.")
7701 ;; (anything 'anything-c-source-mac-spotlight)
7703 ;;; Picklist
7704 (defvar anything-c-source-picklist
7705 '((name . "Picklist")
7706 (candidates . (lambda () (mapcar 'car picklist-list)))
7707 (type . file)))
7708 ;; (anything 'anything-c-source-picklist)
7712 ;;; Kill ring
7715 (defvar anything-c-source-kill-ring
7716 '((name . "Kill Ring")
7717 (init . (lambda () (anything-attrset 'last-command last-command)))
7718 (candidates . anything-c-kill-ring-candidates)
7719 (filtered-candidate-transformer anything-c-kill-ring-transformer)
7720 (action . anything-c-kill-ring-action)
7721 (last-command)
7722 (migemo)
7723 (multiline))
7724 "Source for browse and insert contents of kill-ring.")
7726 (defun anything-c-kill-ring-candidates ()
7727 (loop for kill in (anything-fast-remove-dups kill-ring :test 'equal)
7728 unless (or (< (length kill) anything-kill-ring-threshold)
7729 (string-match "^[\\s\\t]+$" kill))
7730 collect kill))
7732 (defun anything-c-kill-ring-transformer (candidates source)
7733 "Display only the `anything-c-kill-ring-max-lines-number' lines of candidate."
7734 (loop for i in candidates
7735 for nlines = (with-temp-buffer (insert i) (count-lines (point-min) (point-max)))
7736 if (and anything-c-kill-ring-max-lines-number
7737 (> nlines anything-c-kill-ring-max-lines-number))
7738 collect (cons
7739 (with-temp-buffer
7740 (insert i)
7741 (goto-char (point-min))
7742 (concat
7743 (buffer-substring
7744 (point-min)
7745 (save-excursion
7746 (forward-line anything-c-kill-ring-max-lines-number)
7747 (point)))
7748 "[...]")) i)
7749 else collect i))
7751 (defun anything-c-kill-ring-action (str)
7752 "Insert STR in `kill-ring' and set STR to the head.
7753 If this action is executed just after `yank',
7754 replace with STR as yanked string."
7755 (setq kill-ring (delete str kill-ring))
7756 (if (not (eq (anything-attr 'last-command) 'yank))
7757 (insert-for-yank str)
7758 ;; from `yank-pop'
7759 (let ((inhibit-read-only t)
7760 (before (< (point) (mark t))))
7761 (if before
7762 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7763 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7764 (setq yank-undo-function nil)
7765 (set-marker (mark-marker) (point) (current-buffer))
7766 (insert-for-yank str)
7767 ;; Set the window start back where it was in the yank command,
7768 ;; if possible.
7769 (set-window-start (selected-window) yank-window-start t)
7770 (if before
7771 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7772 ;; It is cleaner to avoid activation, even though the command
7773 ;; loop would deactivate the mark because we inserted text.
7774 (goto-char (prog1 (mark t)
7775 (set-marker (mark-marker) (point) (current-buffer)))))))
7776 (kill-new str))
7778 ;; (anything 'anything-c-source-kill-ring)
7781 ;;;; <Mark ring>
7782 ;; DO NOT include these sources in `anything-sources' use
7783 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7784 ;; `anything-all-mark-rings' instead.
7786 (defun anything-c-source-mark-ring-candidates ()
7787 (flet ((get-marks (pos)
7788 (save-excursion
7789 (goto-char pos)
7790 (beginning-of-line)
7791 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7792 (when (string= "" line)
7793 (setq line "<EMPTY LINE>"))
7794 (format "%7d: %s" (line-number-at-pos) line)))))
7795 (with-anything-current-buffer
7796 (loop
7797 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7798 with recip = nil
7799 for i in marks
7800 for m = (get-marks i)
7801 unless (member m recip)
7802 collect m into recip
7803 finally return recip))))
7805 (defvar anything-mark-ring-cache nil)
7806 (defvar anything-c-source-mark-ring
7807 '((name . "mark-ring")
7808 (init . (lambda ()
7809 (setq anything-mark-ring-cache
7810 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7811 (candidates . (lambda ()
7812 (anything-aif anything-mark-ring-cache
7813 it)))
7814 (action . (("Goto line"
7815 . (lambda (candidate)
7816 (anything-goto-line (string-to-number candidate))))))
7817 (persistent-action . (lambda (candidate)
7818 (anything-goto-line (string-to-number candidate))
7819 (anything-match-line-color-current-line)))
7820 (persistent-help . "Show this line")))
7822 ;; (anything 'anything-c-source-mark-ring)
7824 ;;; Global-mark-ring
7825 (defvar anything-c-source-global-mark-ring
7826 '((name . "global-mark-ring")
7827 (candidates . anything-c-source-global-mark-ring-candidates)
7828 (action . (("Goto line"
7829 . (lambda (candidate)
7830 (let ((items (split-string candidate ":")))
7831 (anything-c-switch-to-buffer (second items))
7832 (anything-goto-line (string-to-number (car items))))))))
7833 (persistent-action . (lambda (candidate)
7834 (let ((items (split-string candidate ":")))
7835 (anything-c-switch-to-buffer (second items))
7836 (anything-goto-line (string-to-number (car items)))
7837 (anything-match-line-color-current-line))))
7838 (persistent-help . "Show this line")))
7840 (defun anything-c-source-global-mark-ring-candidates ()
7841 (flet ((buf-fn (m)
7842 (with-current-buffer (marker-buffer m)
7843 (goto-char m)
7844 (beginning-of-line)
7845 (let (line)
7846 (if (string= "" line)
7847 (setq line "<EMPTY LINE>")
7848 (setq line (car (split-string (thing-at-point 'line)
7849 "[\n\r]"))))
7850 (format "%7d:%s: %s"
7851 (line-number-at-pos) (marker-buffer m) line)))))
7852 (loop
7853 with marks = global-mark-ring
7854 with recip = nil
7855 for i in marks
7856 for gm = (unless (or (string-match
7857 "^ " (format "%s" (marker-buffer i)))
7858 (null (marker-buffer i)))
7859 (buf-fn i))
7860 when (and gm (not (member gm recip)))
7861 collect gm into recip
7862 finally return recip)))
7864 ;; (anything 'anything-c-source-global-mark-ring)
7867 ;;;; <Register>
7868 ;;; Insert from register
7869 (defvar anything-c-source-register
7870 '((name . "Registers")
7871 (candidates . anything-c-register-candidates)
7872 (action-transformer . anything-c-register-action-transformer)
7873 (multiline)
7874 (action))
7875 "See (info \"(emacs)Registers\")")
7877 (defun anything-c-register-candidates ()
7878 "Collecting register contents and appropriate commands."
7879 (loop for (char . val) in register-alist
7880 for key = (single-key-description char)
7881 for string-actions =
7882 (cond
7883 ((numberp val)
7884 (list (int-to-string val)
7885 'insert-register
7886 'increment-register))
7887 ((markerp val)
7888 (let ((buf (marker-buffer val)))
7889 (if (null buf)
7890 (list "a marker in no buffer")
7891 (list (concat
7892 "a buffer position:"
7893 (buffer-name buf)
7894 ", position "
7895 (int-to-string (marker-position val)))
7896 'jump-to-register
7897 'insert-register))))
7898 ((and (consp val) (window-configuration-p (car val)))
7899 (list "window configuration."
7900 'jump-to-register))
7901 ((and (consp val) (frame-configuration-p (car val)))
7902 (list "frame configuration."
7903 'jump-to-register))
7904 ((and (consp val) (eq (car val) 'file))
7905 (list (concat "file:"
7906 (prin1-to-string (cdr val))
7907 ".")
7908 'jump-to-register))
7909 ((and (consp val) (eq (car val) 'file-query))
7910 (list (concat "file:a file-query reference: file "
7911 (car (cdr val))
7912 ", position "
7913 (int-to-string (car (cdr (cdr val))))
7914 ".")
7915 'jump-to-register))
7916 ((consp val)
7917 (let ((lines (format "%4d" (length val))))
7918 (list (format "%s: %s\n" lines
7919 (truncate-string-to-width
7920 (mapconcat 'identity (list (car val))
7921 ;; (mapconcat (lambda (y) y) val
7922 "^J") (- (window-width) 15)))
7923 'insert-register)))
7924 ((stringp val)
7925 (list ;; without properties
7926 (substring-no-properties val)
7927 'insert-register
7928 'append-to-register
7929 'prepend-to-register))
7931 "GARBAGE!"))
7932 collect (cons (format "register %3s: %s" key (car string-actions))
7933 (cons char (cdr string-actions)))))
7935 (defun anything-c-register-action-transformer (actions register-and-functions)
7936 "Decide actions by the contents of register."
7937 (loop with func-actions =
7938 '((insert-register
7939 "Insert Register" .
7940 (lambda (c) (insert-register (car c))))
7941 (jump-to-register
7942 "Jump to Register" .
7943 (lambda (c) (jump-to-register (car c))))
7944 (append-to-register
7945 "Append Region to Register" .
7946 (lambda (c) (append-to-register
7947 (car c) (region-beginning) (region-end))))
7948 (prepend-to-register
7949 "Prepend Region to Register" .
7950 (lambda (c) (prepend-to-register
7951 (car c) (region-beginning) (region-end))))
7952 (increment-register
7953 "Increment Prefix Arg to Register" .
7954 (lambda (c) (increment-register
7955 anything-current-prefix-arg (car c)))))
7956 for func in (cdr register-and-functions)
7957 for cell = (assq func func-actions)
7958 when cell
7959 collect (cdr cell)))
7961 ;; (anything 'anything-c-source-register)
7964 ;;; Latex completion
7965 (defun anything-c-latex-math-candidates ()
7966 "Collect candidates for latex math completion."
7967 (declare (special LaTeX-math-menu))
7968 (loop for i in (cddr LaTeX-math-menu)
7969 for elm = (loop for s in i when (vectorp s)
7970 collect (cons (aref s 0) (aref s 1)))
7971 append elm))
7973 (defvar anything-c-source-latex-math
7974 '((name . "Latex Math Menu")
7975 (init . (lambda ()
7976 (with-anything-current-buffer
7977 (LaTeX-math-mode 1))))
7978 (candidate-number-limit . 9999)
7979 (candidates . anything-c-latex-math-candidates)
7980 (action . (lambda (candidate)
7981 (call-interactively candidate)))))
7984 ;;;; <Headline Extraction>
7985 (defvar anything-c-source-fixme
7986 '((name . "TODO/FIXME/DRY comments")
7987 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7988 (adjust)
7989 (recenter))
7990 "Show TODO/FIXME/DRY comments in current file.")
7991 ;; (anything 'anything-c-source-fixme)
7993 (defvar anything-c-source-rd-headline
7994 '((name . "RD HeadLine")
7995 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7996 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7997 (migemo)
7998 (subexp . 1))
7999 "Show RD headlines.
8001 RD is Ruby's POD.
8002 http://en.wikipedia.org/wiki/Ruby_Document_format")
8003 ;; (anything 'anything-c-source-rd-headline)
8005 (defvar anything-c-source-oddmuse-headline
8006 '((name . "Oddmuse HeadLine")
8007 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
8008 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
8009 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
8010 (migemo)
8011 (subexp . 1))
8012 "Show Oddmuse headlines, such as EmacsWiki.")
8013 ;; (anything 'anything-c-source-oddmuse-headline)
8015 (defvar anything-c-source-emacs-source-defun
8016 '((name . "Emacs Source DEFUN")
8017 (headline . "DEFUN\\|DEFVAR")
8018 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
8019 (or buffer-file-name ""))))
8020 "Show DEFUN/DEFVAR in Emacs C source file.")
8021 ;; (anything 'anything-c-source-emacs-source-defun)
8023 (defvar anything-c-source-emacs-lisp-expectations
8024 '((name . "Emacs Lisp Expectations")
8025 (headline . "(desc[ ]\\|(expectations")
8026 (condition . (eq major-mode 'emacs-lisp-mode)))
8027 "Show descriptions (desc) in Emacs Lisp Expectations.
8029 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
8030 ;; (anything 'anything-c-source-emacs-lisp-expectations)
8032 (defvar anything-c-source-emacs-lisp-toplevels
8033 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
8034 (headline . "^(\\|(@\\*\\|^;;;;")
8035 (get-line . buffer-substring)
8036 (condition . (eq major-mode 'emacs-lisp-mode))
8037 (adjust))
8038 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
8039 linkd.el is optional because linkd stars are extracted by regexp.
8040 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
8041 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
8044 ;;; Anything yaoddmuse
8046 ;; Be sure to have yaoddmuse.el installed
8047 ;; install-elisp may be required if you want to install elisp file from here.
8048 (defvar anything-yaoddmuse-use-cache-file nil)
8049 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
8050 (defvar anything-c-yaoddmuse-ew-cache nil)
8052 (defun anything-yaoddmuse-get-candidates ()
8053 (declare (special yaoddmuse-pages-hash))
8054 (if anything-yaoddmuse-use-cache-file
8055 (ignore-errors
8056 (unless anything-c-yaoddmuse-ew-cache
8057 (load anything-c-yaoddmuse-cache-file)
8058 (setq anything-c-yaoddmuse-ew-cache
8059 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
8060 anything-c-yaoddmuse-ew-cache)
8061 (yaoddmuse-update-pagename t)
8062 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
8064 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
8065 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
8066 (candidates . anything-yaoddmuse-get-candidates)
8067 (action . (("Edit page" . (lambda (candidate)
8068 (yaoddmuse-edit "EmacsWiki" candidate)))
8069 ("Browse page"
8070 . (lambda (candidate)
8071 (yaoddmuse-browse-page "EmacsWiki" candidate)))
8072 ("Browse page other window"
8073 . (lambda (candidate)
8074 (if (one-window-p)
8075 (split-window-vertically))
8076 (yaoddmuse-browse-page "EmacsWiki" candidate)))
8077 ("Browse diff"
8078 . (lambda (candidate)
8079 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
8080 ("Copy URL"
8081 . (lambda (candidate)
8082 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
8083 (message "Have copy page %s's URL to yank." candidate)))
8084 ("Create page"
8085 . (lambda (candidate)
8086 (yaoddmuse-edit "EmacsWiki" anything-input)))
8087 ("Update cache"
8088 . (lambda (candidate)
8089 (if anything-yaoddmuse-use-cache-file
8090 (progn
8091 (anything-yaoddmuse-cache-pages t)
8092 (setq anything-c-yaoddmuse-ew-cache
8093 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
8094 (yaoddmuse-update-pagename))))))
8095 (action-transformer anything-c-yaoddmuse-action-transformer))
8096 "Needs yaoddmuse.el.
8098 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
8100 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
8102 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
8103 '((name . "Yaoddmuse Post library (EmacsWiki)")
8104 (init . (anything-yaoddmuse-init))
8105 (candidates-in-buffer)
8106 (action . (("Post library and Browse"
8107 . (lambda (candidate)
8108 (yaoddmuse-post-file
8109 (find-library-name candidate)
8110 "EmacsWiki"
8111 (file-name-nondirectory (find-library-name candidate))
8112 nil t)))
8113 ("Post library"
8114 . (lambda (candidate)
8115 (yaoddmuse-post-file
8116 (find-library-name candidate)
8117 "EmacsWiki"
8118 (file-name-nondirectory
8119 (find-library-name candidate))))))))
8120 "Needs yaoddmuse.el.
8122 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
8124 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
8126 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
8127 "Allow the use of `install-elisp' only on elisp files."
8128 (if (string-match "\.el$" candidate)
8129 (append actions '(("Install Elisp"
8130 . (lambda (elm)
8131 (install-elisp-from-emacswiki elm)))))
8132 actions))
8134 ;;;###autoload
8135 (defun anything-yaoddmuse-cache-pages (&optional load)
8136 "Fetch the list of files on emacswiki and create cache file.
8137 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
8138 (interactive)
8139 (declare (special yaoddmuse-pages-hash))
8140 (yaoddmuse-update-pagename)
8141 (save-excursion
8142 (find-file anything-c-yaoddmuse-cache-file)
8143 (erase-buffer)
8144 (insert "(puthash \"EmacsWiki\" '(")
8145 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
8147 (insert (concat "(\"" (car i) "\") ")))
8148 (insert ") yaoddmuse-pages-hash)\n")
8149 (save-buffer)
8150 (kill-buffer (current-buffer))
8151 (when (or current-prefix-arg
8152 load)
8153 (load anything-c-yaoddmuse-cache-file))))
8155 (defun anything-yaoddmuse-init ()
8156 "Init anything buffer status."
8157 (let ((anything-buffer (anything-candidate-buffer 'global))
8158 (library-list (yaoddmuse-get-library-list)))
8159 (with-current-buffer anything-buffer
8160 ;; Insert library name.
8161 (dolist (library library-list)
8162 (insert (format "%s\n" library)))
8163 ;; Sort lines.
8164 (sort-lines nil (point-min) (point-max)))))
8167 ;;; Eev anchors
8168 (defvar anything-c-source-eev-anchor
8169 '((name . "Anchors")
8170 (candidates
8171 . (lambda ()
8172 (ignore-errors
8173 (with-anything-current-buffer
8174 (loop initially (goto-char (point-min))
8175 while (re-search-forward
8176 (format ee-anchor-format "\\([^\.].+\\)") nil t)
8177 for anchor = (match-string-no-properties 1)
8178 collect (cons (format "%5d:%s"
8179 (line-number-at-pos (match-beginning 0))
8180 (format ee-anchor-format anchor))
8181 anchor))))))
8182 (persistent-action . (lambda (item)
8183 (ee-to item)
8184 (anything-match-line-color-current-line)))
8185 (persistent-help . "Show this entry")
8186 (action . (("Goto link" . ee-to)))))
8187 ;; (anything 'anything-c-source-eev-anchor)
8190 ;;; Org headlines
8193 (defvar anything-c-source-org-headline
8194 '((name . "Org HeadLine")
8195 (headline "^\\*\\{1,8\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
8196 (condition . (eq major-mode 'org-mode))
8197 (migemo)
8198 (subexp . 1)
8199 (persistent-action . (lambda (elm)
8200 (anything-c-action-line-goto elm)
8201 (org-cycle)))
8202 (action-transformer
8203 . (lambda (actions candidate)
8204 '(("Go to Line" . anything-c-action-line-goto)
8205 ("Insert Link to This Headline"
8206 . anything-c-org-headline-insert-link-to-headline)))))
8207 "Show Org headlines.
8208 org-mode is very very much extended text-mode/outline-mode.
8210 See (find-library \"org.el\")
8211 See http://orgmode.org for the latest version.")
8213 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
8214 (insert
8215 (save-excursion
8216 (anything-goto-line (car lineno-and-content))
8217 (and (looking-at org-complex-heading-regexp)
8218 (org-make-link-string (concat "*" (match-string 4)))))))
8219 ;; (anything 'anything-c-source-org-headline)
8221 ;;; Org keywords
8224 (defvar anything-c-source-org-keywords
8225 '((name . "Org Keywords")
8226 (init . anything-c-org-keywords-init)
8227 (candidates . anything-c-org-keywords-candidates)
8228 (action . anything-c-org-keywords-insert)
8229 (persistent-action . anything-c-org-keywords-show-help)
8230 (persistent-help . "Show an example and info page to describe this keyword.")
8231 (keywords-examples)
8232 (keywords)))
8233 ;; (anything 'anything-c-source-org-keywords)
8235 (defvar anything-c-org-keywords-info-location
8236 '(("#+TITLE:" . "(org)Export options")
8237 ("#+AUTHOR:" . "(org)Export options")
8238 ("#+DATE:" . "(org)Export options")
8239 ("#+EMAIL:" . "(org)Export options")
8240 ("#+DESCRIPTION:" . "(org)Export options")
8241 ("#+KEYWORDS:" . "(org)Export options")
8242 ("#+LANGUAGE:" . "(org)Export options")
8243 ("#+TEXT:" . "(org)Export options")
8244 ("#+TEXT:" . "(org)Export options")
8245 ("#+OPTIONS:" . "(org)Export options")
8246 ("#+BIND:" . "(org)Export options")
8247 ("#+LINK_UP:" . "(org)Export options")
8248 ("#+LINK_HOME:" . "(org)Export options")
8249 ("#+LATEX_HEADER:" . "(org)Export options")
8250 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
8251 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
8252 ("#+INFOJS_OPT" . "(org)Javascript support")
8253 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
8254 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
8255 ("#+ORGTBL" . "(org)Radio tables")
8256 ("#+HTML:" . "(org)Quoting HTML tags")
8257 ("#+LaTeX:" . "(org)Quoting LaTeX code")
8258 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
8259 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
8260 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
8261 ("#+BEGIN_VERSE" . "(org)Paragraphs")
8262 ("#+BEGIN_SRC" . "(org)Literal examples")
8263 ("#+CAPTION" . "(org)Tables in HTML export")
8264 ("#+LABEL" . "(org)Tables in LaTeX export")
8265 ("#+ATTR_HTML" . "(org)Links")
8266 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
8268 (defun anything-c-org-keywords-init ()
8269 (unless (anything-attr 'keywords-examples)
8270 (require 'org)
8271 (anything-attrset 'keywords-examples
8272 (append
8273 (mapcar
8274 (lambda (x)
8275 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
8276 (cons (match-string 2 x) (match-string 1 x)))
8277 (org-split-string (org-get-current-options) "\n"))
8278 (mapcar 'list org-additional-option-like-keywords)))
8279 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
8281 (defun anything-c-org-keywords-candidates ()
8282 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
8283 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
8284 (anything-attr 'keywords)))
8286 (defun anything-c-org-keywords-insert (keyword)
8287 (cond ((and (string-match "BEGIN" keyword)
8288 (anything-region-active-p))
8289 (let ((beg (region-beginning))
8290 (end (region-end)))
8291 (goto-char end)
8292 (insert "\n#+" (replace-regexp-in-string
8293 "BEGIN" "END" keyword) "\n")
8294 (goto-char beg)
8295 (insert "#+" keyword " ")
8296 (save-excursion (insert "\n"))))
8297 ((string-match "BEGIN" keyword)
8298 (insert "#+" keyword " ")
8299 (save-excursion
8300 (insert "\n#+" (replace-regexp-in-string
8301 "BEGIN" "END" keyword) "\n")))
8302 (t (insert "#+" keyword " "))))
8304 (defun anything-c-org-keywords-show-help (keyword)
8305 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
8306 "(org)In-buffer settings"))
8307 (search-forward (concat "#+" keyword) nil t)
8308 (anything-persistent-highlight-point)
8309 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
8313 ;;; bbdb
8316 (defvar bbdb-records)
8317 (defvar bbdb-buffer-name)
8319 (defun anything-c-bbdb-candidates ()
8320 "Return a list of all names in the bbdb database. The format
8321 is \"Firstname Lastname\"."
8322 (mapcar (lambda (bbdb-record)
8323 (replace-regexp-in-string
8324 "\\s-+$" ""
8325 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
8326 (bbdb-records)))
8328 (defun anything-c-bbdb-create-contact (actions candidate)
8329 "Action transformer that returns only an entry to add the
8330 current `anything-pattern' as new contact. All other actions are
8331 removed."
8332 (if (string= candidate "*Add to contacts*")
8333 '(("Add to contacts" . (lambda (actions)
8334 (bbdb-create-internal
8335 (read-from-minibuffer "Name: " anything-c-bbdb-name)
8336 (read-from-minibuffer "Company: ")
8337 (read-from-minibuffer "Email: ")
8340 (read-from-minibuffer "Note: ")))))
8341 actions))
8343 (defun anything-c-bbdb-get-record (candidate)
8344 "Return record that match CANDIDATE."
8345 (bbdb candidate nil)
8346 (set-buffer "*BBDB*")
8347 (bbdb-current-record))
8349 (defvar anything-c-bbdb-name nil
8350 "Only for internal use.")
8352 (defvar anything-c-source-bbdb
8353 '((name . "BBDB")
8354 (candidates . anything-c-bbdb-candidates)
8355 (action ("Send a mail" . anything-c-bbdb-compose-mail)
8356 ("View person's data" . anything-c-bbdb-view-person-action))
8357 (filtered-candidate-transformer . (lambda (candidates source)
8358 (setq anything-c-bbdb-name anything-pattern)
8359 (if (not candidates)
8360 (list "*Add to contacts*")
8361 candidates)))
8362 (action-transformer . (lambda (actions candidate)
8363 (anything-c-bbdb-create-contact actions candidate))))
8364 "Needs BBDB.
8366 http://bbdb.sourceforge.net/")
8367 ;; (anything 'anything-c-source-bbdb)
8369 (defun anything-c-bbdb-view-person-action (candidate)
8370 "View BBDB data of single CANDIDATE or marked candidates."
8371 (anything-aif (anything-marked-candidates)
8372 (let ((bbdb-append-records (length it)))
8373 (dolist (i it)
8374 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
8375 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
8377 (defun anything-c-bbdb-collect-mail-addresses ()
8378 "Return a list of all mail addresses of records in bbdb buffer."
8379 (with-current-buffer bbdb-buffer-name
8380 (loop for i in bbdb-records
8381 if (bbdb-record-net (car i))
8382 collect (bbdb-dwim-net-address (car i)))))
8384 (defun anything-c-bbdb-compose-mail (candidate)
8385 "Compose a mail with all records of bbdb buffer."
8386 (anything-c-bbdb-view-person-action candidate)
8387 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
8388 (address-str (mapconcat 'identity address-list ",\n ")))
8389 (compose-mail address-str)))
8392 ;;; Evaluation Result
8395 ;; Internal
8396 (defvar anything-eldoc-active-minibuffers-list nil)
8398 (defvar anything-c-source-evaluation-result
8399 '((name . "Evaluation Result")
8400 (disable-shortcuts)
8401 (dummy)
8402 (multiline)
8403 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
8404 (filtered-candidate-transformer . (lambda (candidates source)
8405 (list
8406 (condition-case nil
8407 (with-anything-current-buffer
8408 (pp-to-string
8409 (eval (read anything-pattern))))
8410 (error "Error")))))
8411 (action . (("Copy result to kill-ring" . (lambda (candidate)
8412 (with-current-buffer anything-buffer
8413 (let ((end (save-excursion
8414 (goto-char (point-max))
8415 (search-backward "\n")
8416 (point))))
8417 (kill-region (point) end)))))
8418 ("copy sexp to kill-ring" . (lambda (candidate)
8419 (kill-new anything-input)))))))
8420 ;; (anything 'anything-c-source-evaluation-result)
8422 (defun anything-eval-new-line-and-indent ()
8423 (interactive)
8424 (newline) (lisp-indent-line))
8426 (defun anything-eldoc-store-minibuffer ()
8427 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8428 (with-selected-window (minibuffer-window)
8429 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8431 (defun anything-eldoc-show-in-eval ()
8432 "Return eldoc in mode-line for current minibuffer input."
8433 (let ((buf (with-selected-window (minibuffer-window)
8434 (buffer-name))))
8435 (when (member buf anything-eldoc-active-minibuffers-list)
8436 (let* ((str-all (with-current-buffer buf
8437 (minibuffer-completion-contents)))
8438 (sym (when str-all
8439 (with-temp-buffer
8440 (insert str-all)
8441 (goto-char (point-max))
8442 (unless (looking-back ")\\|\"") (forward-char -1))
8443 (eldoc-current-symbol))))
8444 (info-fn (eldoc-fnsym-in-current-sexp))
8445 (doc (or (eldoc-get-var-docstring sym)
8446 (eldoc-get-fnsym-args-string
8447 (car info-fn) (cadr info-fn)))))
8448 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8450 (defun anything-c-eldoc-show-in-mode-line (str)
8451 "Show string STR in mode-line."
8452 (save-window-excursion
8453 (with-current-buffer anything-buffer
8454 (let ((mode-line-format (concat " " str)))
8455 (force-mode-line-update)
8456 (sit-for anything-c-eldoc-show-in-mode-line-delay))
8457 (force-mode-line-update))))
8459 ;;; Calculation Result
8462 (defvar anything-c-source-calculation-result
8463 '((name . "Calculation Result")
8464 (dummy)
8465 (filtered-candidate-transformer . (lambda (candidates source)
8466 (list
8467 (condition-case nil
8468 (calc-eval anything-pattern)
8469 (error "error")))))
8470 (action ("Copy result to kill-ring" . kill-new))))
8471 ;; (anything 'anything-c-source-calculation-result)
8474 ;;; Google Suggestions
8477 ;; Internal
8478 (defvar anything-ggs-max-length-real-flag 0)
8479 (defvar anything-ggs-max-length-num-flag 0)
8481 (defun anything-c-google-suggest-fetch (input)
8482 "Fetch suggestions for INPUT from XML buffer.
8483 Return an alist with elements like (data . number_results)."
8484 (setq anything-ggs-max-length-real-flag 0
8485 anything-ggs-max-length-num-flag 0)
8486 (let ((request (concat anything-c-google-suggest-url
8487 (url-hexify-string input))))
8488 (flet ((fetch ()
8489 (loop
8490 with result-alist = (xml-get-children
8491 (car (xml-parse-region
8492 (point-min) (point-max)))
8493 'CompleteSuggestion)
8494 for i in result-alist
8495 for data = (cdr (caadr (assoc 'suggestion i)))
8496 for nqueries = (cdr (caadr (assoc 'num_queries i)))
8497 for lqueries = (length (anything-c-ggs-set-number-result
8498 nqueries))
8499 for ldata = (length data)
8501 (progn
8502 (when (> ldata anything-ggs-max-length-real-flag)
8503 (setq anything-ggs-max-length-real-flag ldata))
8504 (when (> lqueries anything-ggs-max-length-num-flag)
8505 (setq anything-ggs-max-length-num-flag lqueries)))
8506 collect (cons data nqueries) into cont
8507 finally return cont)))
8508 (if anything-google-suggest-use-curl-p
8509 (with-temp-buffer
8510 (call-process "curl" nil t nil request)
8511 (fetch))
8512 (with-current-buffer
8513 (url-retrieve-synchronously request)
8514 (fetch))))))
8516 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8517 "Set candidates with result and number of google results found."
8518 (let ((suggestions
8519 (loop with suggested-results = (anything-c-google-suggest-fetch
8520 (or (and request-prefix
8521 (concat request-prefix " " anything-pattern))
8522 anything-pattern))
8523 for (real . numresult) in suggested-results
8524 ;; Prepare number of results with ","
8525 for fnumresult = (anything-c-ggs-set-number-result numresult)
8526 ;; Calculate number of spaces to add before fnumresult
8527 ;; if it is smaller than longest result
8528 ;; `anything-ggs-max-length-num-flag'.
8529 ;; e.g 1,234,567
8530 ;; 345,678
8531 ;; To be sure it is aligned properly.
8532 for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
8533 (- anything-ggs-max-length-num-flag (length fnumresult))
8535 ;; Add now the spaces before fnumresult.
8536 for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
8537 for interval = (- anything-ggs-max-length-real-flag (length real))
8538 for spaces = (make-string (+ 2 interval) ? )
8539 for display = (format "%s%s(%s results)" real spaces align-fnumresult)
8540 collect (cons display real))))
8541 (if (loop for (disp . dat) in suggestions
8542 thereis (equal dat anything-pattern))
8543 suggestions
8544 ;; if there is no suggestion exactly matching the input then
8545 ;; prepend a Search on Google item to the list
8546 (append
8547 suggestions
8548 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8549 anything-input))))))
8551 (defun anything-c-ggs-set-number-result (num)
8552 (if num
8553 (progn
8554 (and (numberp num) (setq num (number-to-string num)))
8555 (loop for i in (reverse (split-string num "" t))
8556 for count from 1
8557 append (list i) into C
8558 when (= count 3)
8559 append (list ",") into C
8560 and do (setq count 0)
8561 finally return
8562 (replace-regexp-in-string
8563 "^," "" (mapconcat 'identity (reverse C) ""))))
8564 "?"))
8566 (defvar anything-c-google-suggest-default-browser-function nil
8567 "*The browse url function you prefer to use with google suggest.
8568 When nil, use the first browser function available
8569 See `anything-browse-url-default-browser-alist'.")
8571 (defun anything-c-google-suggest-action (candidate)
8572 "Default action to jump to a google suggested candidate."
8573 (let ((arg (concat anything-c-google-suggest-search-url
8574 (url-hexify-string candidate))))
8575 (anything-aif anything-c-google-suggest-default-browser-function
8576 (funcall it arg)
8577 (anything-c-browse-url arg))))
8579 (defvar anything-c-google-suggest-default-function
8580 'anything-c-google-suggest-set-candidates
8581 "Default function to use in anything google suggest.")
8583 (defvar anything-c-source-google-suggest
8584 '((name . "Google Suggest")
8585 (candidates . (lambda ()
8586 (funcall anything-c-google-suggest-default-function)))
8587 (action . (("Google Search" . anything-c-google-suggest-action)))
8588 (volatile)
8589 (requires-pattern . 3)
8590 (delayed)))
8592 (defun anything-c-google-suggest-emacs-lisp ()
8593 "Try to emacs lisp complete with google suggestions."
8594 (anything-c-google-suggest-set-candidates "emacs lisp"))
8596 ;; (anything 'anything-c-source-google-suggest)
8598 ;;; Yahoo suggestions
8601 (defun anything-c-yahoo-suggest-fetch (input)
8602 "Fetch Yahoo suggestions for INPUT from XML buffer.
8603 Return an alist with elements like (data . number_results)."
8604 (let ((request (concat anything-c-yahoo-suggest-url
8605 (url-hexify-string input))))
8606 (flet ((fetch ()
8607 (loop
8608 with result-alist = (xml-get-children
8609 (car (xml-parse-region (point-min) (point-max)))
8610 'Result)
8611 for i in result-alist
8612 collect (caddr i))))
8613 (with-current-buffer
8614 (url-retrieve-synchronously request)
8615 (fetch)))))
8617 (defun anything-c-yahoo-suggest-set-candidates ()
8618 "Set candidates with Yahoo results found."
8619 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8620 (or suggestions
8621 (append
8622 suggestions
8623 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8624 anything-input))))))
8626 (defun anything-c-yahoo-suggest-action (candidate)
8627 "Default action to jump to a Yahoo suggested candidate."
8628 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8629 (url-hexify-string candidate))))
8631 (defvar anything-c-source-yahoo-suggest
8632 '((name . "Yahoo Suggest")
8633 (candidates . anything-c-yahoo-suggest-set-candidates)
8634 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8635 (volatile)
8636 (requires-pattern . 3)
8637 (delayed)))
8639 ;; (anything 'anything-c-source-yahoo-suggest)
8642 ;;; Web browser functions.
8645 (require 'browse-url)
8646 ;; If default setting of `w3m-command' is not
8647 ;; what you want you and you modify it, you will have to reeval
8648 ;; also `anything-browse-url-default-browser-alist'.
8649 (defvar w3m-command "/usr/bin/w3m")
8650 (defvar anything-c-home-url "http://www.google.fr"
8651 "*Default url to use as home url.")
8653 (defvar browse-url-chromium-program "chromium-browser")
8654 (defvar browse-url-uzbl-program "uzbl-browser")
8655 (defvar anything-browse-url-default-browser-alist
8656 `((,w3m-command . w3m-browse-url)
8657 (,browse-url-firefox-program . browse-url-firefox)
8658 (,browse-url-chromium-program . browse-url-chromium)
8659 (,browse-url-uzbl-program . browse-url-uzbl)
8660 (,browse-url-kde-program . browse-url-kde)
8661 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8662 (,browse-url-mozilla-program . browse-url-mozilla)
8663 (,browse-url-galeon-program . browse-url-galeon)
8664 (,browse-url-netscape-program . browse-url-netscape)
8665 (,browse-url-mosaic-program . browse-url-mosaic)
8666 (,browse-url-xterm-program . browse-url-text-xterm))
8667 "*Alist of (executable . function) to try to find a suitable url browser.")
8669 (defun* anything-c-generic-browser (url name &rest args)
8670 "Browse URL with NAME browser."
8671 (let ((proc (concat name " " url)))
8672 (message "Starting %s..." name)
8673 (apply 'start-process proc nil name
8674 (append args (list url)))
8675 (set-process-sentinel
8676 (get-process proc)
8677 #'(lambda (process event)
8678 (when (string= event "finished\n")
8679 (message "%s process %s" process event))))))
8681 (defun browse-url-chromium (url)
8682 "Browse URL with google chrome browser."
8683 (interactive "sURL: ")
8684 (anything-c-generic-browser
8685 url browse-url-chromium-program))
8687 (defun browse-url-uzbl (url &optional ignore)
8688 "Browse URL with uzbl browser."
8689 (interactive "sURL: ")
8690 (anything-c-generic-browser url browse-url-uzbl-program "-u"))
8692 (defun anything-browse-url-default-browser (url &rest args)
8693 "Find the first available browser and ask it to load URL."
8694 (let ((default-browser-fn
8695 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8696 thereis (and exe (executable-find exe) fn))))
8697 (if default-browser-fn
8698 (apply default-browser-fn url args)
8699 (error "No usable browser found"))))
8701 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8702 "Default command to browse URL."
8703 (if browse-url-browser-function
8704 (browse-url url)
8705 (anything-browse-url-default-browser url)))
8708 ;;; Surfraw
8710 ;; Need external program surfraw.
8711 ;; <http://surfraw.alioth.debian.org/>
8713 (defvar anything-surfraw-default-browser-function nil
8714 "*The browse url function you prefer to use with surfraw.
8715 When nil, fallback to `browse-url-browser-function'.")
8717 ;; Internal
8718 (defvar anything-surfraw-engines-history nil)
8720 (defun anything-c-build-elvi-list ()
8721 "Return list of all engines and descriptions handled by surfraw."
8722 (cdr
8723 (with-temp-buffer
8724 (call-process "surfraw" nil t nil
8725 "-elvi")
8726 (split-string (buffer-string) "\n"))))
8729 ;;; Emms
8732 (defun anything-emms-stream-edit-bookmark (elm)
8733 "Change the information of current emms-stream bookmark from anything."
8734 (declare (special emms-stream-list))
8735 (let* ((cur-buf anything-current-buffer)
8736 (bookmark (assoc elm emms-stream-list))
8737 (name (read-from-minibuffer "Description: "
8738 (nth 0 bookmark)))
8739 (url (read-from-minibuffer "URL: "
8740 (nth 1 bookmark)))
8741 (fd (read-from-minibuffer "Feed Descriptor: "
8742 (int-to-string (nth 2 bookmark))))
8743 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8744 (format "%s" (car (last bookmark))))))
8745 (save-excursion
8746 (emms-streams)
8747 (when (re-search-forward (concat "^" name) nil t)
8748 (beginning-of-line)
8749 (emms-stream-delete-bookmark)
8750 (emms-stream-add-bookmark name url (string-to-number fd) type)
8751 (emms-stream-save-bookmarks-file)
8752 (emms-stream-quit)
8753 (anything-c-switch-to-buffer cur-buf)))))
8755 (defun anything-emms-stream-delete-bookmark (elm)
8756 "Delete an emms-stream bookmark from anything."
8757 (let* ((cur-buf anything-current-buffer)
8758 (bookmark (assoc elm emms-stream-list))
8759 (name (nth 0 bookmark)))
8760 (save-excursion
8761 (emms-streams)
8762 (when (re-search-forward (concat "^" name) nil t)
8763 (beginning-of-line)
8764 (emms-stream-delete-bookmark)
8765 (emms-stream-save-bookmarks-file)
8766 (emms-stream-quit)
8767 (anything-c-switch-to-buffer cur-buf)))))
8769 (defvar anything-c-source-emms-streams
8770 '((name . "Emms Streams")
8771 (init . (lambda ()
8772 (emms-stream-init)))
8773 (candidates . (lambda ()
8774 (declare (special emms-stream-list))
8775 (mapcar 'car emms-stream-list)))
8776 (action . (("Play" . (lambda (elm)
8777 (declare (special emms-stream-list))
8778 (let* ((stream (assoc elm emms-stream-list))
8779 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8780 (url (second stream)))
8781 (funcall fn url))))
8782 ("Delete" . anything-emms-stream-delete-bookmark)
8783 ("Edit" . anything-emms-stream-edit-bookmark)))
8784 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8785 ;; (anything 'anything-c-source-emms-streams)
8787 ;; Don't forget to set `emms-source-file-default-directory'
8788 (defvar anything-c-source-emms-dired
8789 '((name . "Music Directory")
8790 (candidates . (lambda ()
8791 (cddr (directory-files emms-source-file-default-directory))))
8792 (action .
8793 (("Play Directory" . (lambda (item)
8794 (emms-play-directory
8795 (expand-file-name
8796 item
8797 emms-source-file-default-directory))))
8798 ("Open dired in file's directory" . (lambda (item)
8799 (anything-c-open-dired
8800 (expand-file-name
8801 item
8802 emms-source-file-default-directory))))))
8803 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8804 ;; (anything 'anything-c-source-emms-dired)
8807 (defun anything-c-emms-files-modifier (candidates source)
8808 (let ((current-playlist (with-current-emms-playlist
8809 (loop
8810 with cur-list = (emms-playlist-tracks-in-region
8811 (point-min) (point-max))
8812 for i in cur-list
8813 collect (assoc-default 'name i)))))
8814 (loop for i in candidates
8815 if (member (cdr i) current-playlist)
8816 collect (cons (propertize (car i)
8817 'face 'anything-emms-playlist)
8818 (cdr i)) into lis
8819 else collect i into lis
8820 finally return lis)))
8822 (defun anything-c-emms-play-current-playlist ()
8823 "Play current playlist."
8824 (with-current-emms-playlist
8825 (emms-playlist-first)
8826 (emms-playlist-mode-play-smart)))
8828 (defvar anything-c-source-emms-files
8829 '((name . "Emms files")
8830 (candidates . (lambda ()
8831 (loop for v being the hash-values in emms-cache-db
8832 for name = (assoc-default 'name v)
8833 for artist = (or (assoc-default 'info-artist v) "unknown")
8834 for genre = (or (assoc-default 'info-genre v) "unknown")
8835 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8836 for song = (or (assoc-default 'info-title v) "unknown")
8837 for info = (concat artist " - " genre " - " tracknum ": " song)
8838 unless (string-match "^http:" name) collect (cons info name))))
8839 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8840 (action . (("Play file" . emms-play-file)
8841 ("Add to Playlist and play (C-u clear current)"
8842 . (lambda (candidate)
8843 (when anything-current-prefix-arg
8844 (emms-playlist-current-clear))
8845 (emms-playlist-new)
8846 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8847 (unless emms-player-playing-p
8848 (anything-c-emms-play-current-playlist))))))))
8850 ;; (anything 'anything-c-source-emms-files)
8853 ;;; Jabber Contacts (jabber.el)
8854 (defun anything-c-jabber-online-contacts ()
8855 "List online Jabber contacts."
8856 (with-no-warnings
8857 (let (jids)
8858 (dolist (item (jabber-concat-rosters) jids)
8859 (when (get item 'connected)
8860 (push (if (get item 'name)
8861 (cons (get item 'name) item)
8862 (cons (symbol-name item) item)) jids))))))
8864 (defvar anything-c-source-jabber-contacts
8865 '((name . "Jabber Contacts")
8866 (init . (lambda () (require 'jabber)))
8867 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8868 (action . (lambda (x)
8869 (jabber-chat-with
8870 (jabber-read-account)
8871 (symbol-name
8872 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8873 ;; (anything 'anything-c-source-jabber-contacts)
8877 ;;; Call source.
8878 (defvar anything-source-select-buffer "*anything source select*")
8879 (defvar anything-c-source-call-source
8880 `((name . "Call anything source")
8881 (candidate-number-limit)
8882 (candidates
8883 . (lambda ()
8884 (loop for vname in (all-completions "anything-c-source-" obarray)
8885 for var = (intern vname)
8886 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8887 if name collect
8888 (cons (format "%s `%s'"
8889 name (propertize vname 'face 'font-lock-variable-name-face))
8890 var))))
8891 (action
8892 . (("Invoke anything with selected source"
8894 (lambda (candidate)
8895 (setq anything-candidate-number-limit 9999)
8896 (anything candidate nil nil nil nil
8897 anything-source-select-buffer)))
8898 ("Describe variable" . describe-variable)
8899 ("Find variable" . find-variable)))
8900 (persistent-action . describe-variable)
8901 (persistent-help . "Show description of this source")))
8902 ;; (anything 'anything-c-source-call-source)
8904 (defun anything-call-source-from-anything ()
8905 "Call anything source within `anything' session."
8906 (interactive)
8907 (setq anything-input-idle-delay 0)
8908 (anything-set-sources '(anything-c-source-call-source)))
8910 ;;; Execute Preconfigured anything.
8911 (defvar anything-c-source-anything-commands
8912 '((name . "Preconfigured Anything")
8913 (candidates . anything-c-anything-commands-candidates)
8914 (type . command)
8915 (candidate-number-limit)))
8916 ;; (anything 'anything-c-source-anything-commands)
8918 (defun anything-c-anything-commands-candidates ()
8919 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8920 collect (cons (if (where-is-internal cmd nil t)
8921 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8922 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8923 cmd)))
8926 ;;; Occur
8929 (defun anything-c-occur-init ()
8930 "Create the initial anything occur buffer.
8931 If region is active use region as buffer contents
8932 instead of whole buffer."
8933 (with-current-buffer (anything-candidate-buffer 'global)
8934 (erase-buffer)
8935 (let ((buf-contents
8936 (with-anything-current-buffer
8937 (if (anything-region-active-p)
8938 (buffer-substring (region-beginning) (region-end))
8939 (buffer-substring (point-min) (point-max))))))
8940 (insert buf-contents))))
8942 (defun anything-c-occur-get-line (s e)
8943 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8945 (defun anything-c-occur-query-replace-regexp (candidate)
8946 "Query replace regexp starting from CANDIDATE.
8947 If region is active ignore CANDIDATE and replace only in region.
8948 With a prefix arg replace only matches surrounded by word boundaries,
8949 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8950 (let ((regexp anything-input))
8951 (unless (anything-region-active-p)
8952 (anything-c-action-line-goto candidate))
8953 (apply 'query-replace-regexp
8954 (anything-c-query-replace-args regexp))))
8956 (defvar anything-c-source-occur
8957 '((name . "Occur")
8958 (init . anything-c-occur-init)
8959 (candidates-in-buffer)
8960 (migemo)
8961 (get-line . anything-c-occur-get-line)
8962 (display-to-real . anything-c-display-to-real-line)
8963 (action . (("Go to Line" . anything-c-action-line-goto)
8964 ("Query replace regexp (C-u Not inside word.)"
8965 . anything-c-occur-query-replace-regexp)))
8966 (recenter)
8967 (requires-pattern . 1)
8968 (delayed)
8969 (volatile)))
8970 ;; (anything 'anything-c-source-occur)
8973 ;;; Anything browse code.
8974 (defun anything-c-browse-code-get-line (beg end)
8975 "Select line if it match the regexp corresponding to current `major-mode'.
8976 Line is parsed for BEG position to END position."
8977 (let ((str-line (buffer-substring beg end))
8978 (regexp (assoc-default major-mode
8979 anything-c-browse-code-regexp-alist))
8980 (num-line (if (string= anything-pattern "") beg (1- beg))))
8981 (when (and regexp (string-match regexp str-line))
8982 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8985 (defvar anything-c-source-browse-code
8986 '((name . "Browse code")
8987 (init . (lambda ()
8988 (anything-candidate-buffer anything-current-buffer)
8989 (with-anything-current-buffer
8990 (jit-lock-fontify-now))))
8991 (candidate-number-limit . 9999)
8992 (candidates-in-buffer)
8993 (get-line . anything-c-browse-code-get-line)
8994 (type . line)
8995 (recenter)))
8998 ;; Do many actions for input
8999 (defvar anything-c-source-create
9000 '((name . "Create")
9001 (dummy)
9002 (action)
9003 (action-transformer . anything-create--actions))
9004 "Do many create actions from `anything-pattern'.
9005 See also `anything-create--actions'.")
9006 ;; (anything 'anything-c-source-create)
9008 (defun anything-create-from-anything ()
9009 "Run `anything-create' from `anything' as a fallback."
9010 (interactive)
9011 (anything-run-after-quit 'anything-create nil anything-pattern))
9013 (defun anything-create--actions (&rest ignored)
9014 "Default actions for `anything-create' / `anything-c-source-create'."
9015 (remove-if-not
9016 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
9017 (append anything-create--actions-private
9018 '(("find-file" . find-file)
9019 ("find-file other window" . find-file-other-window)
9020 ("New buffer" . anything-c-switch-to-buffer)
9021 ("New buffer other window" . switch-to-buffer-other-window)
9022 ("Bookmark Set" . bookmark-set)
9023 ("Set Register" .
9024 (lambda (x) (set-register (read-char "Register: ") x)))
9025 ("Insert Linkd star" . linkd-insert-star)
9026 ("Insert Linkd Tag" . linkd-insert-tag)
9027 ("Insert Linkd Link" . linkd-insert-link)
9028 ("Insert Linkd Lisp" . linkd-insert-lisp)
9029 ("Insert Linkd Wiki" . linkd-insert-wiki)
9030 ("Google Search" . google)))))
9033 ;; Minibuffer History
9036 (defvar anything-c-source-minibuffer-history
9037 '((name . "Minibuffer History")
9038 (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable)))
9039 (candidates
9040 . (lambda ()
9041 (let ((history (loop
9042 for i in (symbol-value minibuffer-history-variable)
9043 unless (string= "" i) collect i)))
9044 (if (consp (car history))
9045 (mapcar 'prin1-to-string history)
9046 history))))
9047 (migemo)
9048 (action . insert)))
9049 ;; (anything 'anything-c-source-minibuffer-history)
9052 ;;; Elscreen
9055 (defvar anything-c-source-elscreen
9056 '((name . "Elscreen")
9057 (candidates . (lambda ()
9058 (if (cdr (elscreen-get-screen-to-name-alist))
9059 (sort
9060 (loop for sname in (elscreen-get-screen-to-name-alist)
9061 append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
9062 finally (return lst))
9063 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
9064 (action . (("Change Screen".
9065 (lambda (candidate)
9066 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
9067 ("Kill Screen(s)".
9068 (lambda (candidate)
9069 (dolist (i (anything-marked-candidates))
9070 (elscreen-goto (- (aref i 1) (aref "0" 0)))
9071 (elscreen-kill))))
9072 ("Only Screen".
9073 (lambda (candidate)
9074 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
9075 (elscreen-kill-others)))))))
9076 ;; (anything 'anything-c-source-elscreen)
9079 ;;;; <System>
9081 ;;; Top (process)
9082 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
9083 "Top command (batch mode). %s is replaced with `frame-width'.")
9084 (defvar anything-c-source-top
9085 '((name . "Top (Press C-c C-u to refresh)")
9086 (init . anything-c-top-init)
9087 (candidates-in-buffer)
9088 (display-to-real . anything-c-top-display-to-real)
9089 (update . anything-c-top-update)
9090 (persistent-action . anything-c-top-sh-persistent-action)
9091 (persistent-help . "SIGTERM")
9092 (action
9093 ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
9094 ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
9095 ("Copy PID" . (lambda (pid) (kill-new pid))))))
9096 ;; (anything 'anything-c-source-top)
9098 (defun anything-c-top-sh (cmd)
9099 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
9101 (defun anything-c-top-sh-persistent-action (pid)
9102 (delete-other-windows)
9103 (anything-c-top-sh (format "kill -TERM %s" pid))
9104 (anything-force-update))
9106 (defun anything-c-top-init ()
9107 (with-current-buffer (anything-candidate-buffer 'global)
9108 (call-process-shell-command
9109 (format anything-c-top-command
9110 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
9111 nil (current-buffer))))
9113 (defun anything-c-top-display-to-real (line)
9114 (car (split-string line)))
9116 (defun anything-c-top-update ()
9117 (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
9118 (anything-c-top-init)))
9120 ;;; Timers
9121 (defvar anything-c-source-absolute-time-timers
9122 '((name . "Absolute Time Timers")
9123 (candidates . timer-list)
9124 (type . timer)))
9125 ;; (anything 'anything-c-source-absolute-time-timers)
9127 (defvar anything-c-source-idle-time-timers
9128 '((name . "Idle Time Timers")
9129 (candidates . timer-idle-list)
9130 (type . timer)))
9131 ;; (anything 'anything-c-source-idle-time-timers)
9133 (defun anything-c-timer-real-to-display (timer)
9134 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
9135 (append timer nil) ;use `append' to convert vector->list
9136 (format "%s repeat=%5S %s(%s)"
9137 (let ((time (list t1 t2 t3)))
9138 (if idle-delay
9139 (format-time-string "idle-for=%5s" time)
9140 (format-time-string "%m/%d %T" time)))
9141 repeat-delay
9142 func
9143 (mapconcat 'prin1-to-string args " "))))
9145 ;;; X RandR resolution change
9146 ;;; FIXME I do not care multi-display.
9147 (defvar anything-c-xrandr-output "VGA")
9148 (defvar anything-c-xrandr-screen "0")
9149 (defvar anything-c-source-xrandr-change-resolution
9150 '((name . "Change Resolution")
9151 (candidates
9152 . (lambda ()
9153 (with-temp-buffer
9154 (call-process "xrandr" nil (current-buffer) nil
9155 "--screen" anything-c-xrandr-screen "-q")
9156 (goto-char 1)
9157 (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
9158 collect (match-string 1)))))
9159 (action
9160 ("Change Resolution" . (lambda (mode)
9161 (call-process "xrandr" nil nil nil
9162 "--screen" anything-c-xrandr-screen
9163 "--output" anything-c-xrandr-output
9164 "--mode" mode))))))
9165 ;; (anything 'anything-c-source-xrandr-change-resolution)
9167 ;;; Xfont selection
9170 (defun anything-c-persistent-xfont-action (elm)
9171 "Show current font temporarily"
9172 (let ((current-font (cdr (assoc 'font (frame-parameters))))
9173 (default-font elm))
9174 (unwind-protect
9175 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
9176 (set-frame-font current-font))))
9178 (defvar anything-c-xfonts-cache nil)
9179 (defvar anything-c-source-xfonts
9180 '((name . "X Fonts")
9181 (init . (lambda ()
9182 (unless anything-c-xfonts-cache
9183 (setq anything-c-xfonts-cache
9184 (x-list-fonts "*")))))
9185 (candidates . anything-c-xfonts-cache)
9186 (action . (("Copy to kill ring" . (lambda (elm)
9187 (kill-new elm)))
9188 ("Set Font" . (lambda (elm)
9189 (kill-new elm)
9190 (set-frame-font elm 'keep-size)
9191 (message "New font have been copied to kill ring")))))
9192 (persistent-action . anything-c-persistent-xfont-action)
9193 (persistent-help . "Switch to this font temporarily")))
9195 ;; (anything 'anything-c-source-xfonts)
9197 (defvar anything-c-source-emacs-process
9198 '((name . "Emacs Process")
9199 (candidates . (lambda () (mapcar #'process-name (process-list))))
9200 (persistent-action . (lambda (elm)
9201 (delete-process (get-process elm))
9202 (anything-delete-current-selection)))
9203 (persistent-help . "Kill Process")
9204 (action ("Kill Process" . (lambda (elm)
9205 (delete-process (get-process elm)))))))
9206 ;; (anything 'anything-c-source-emacs-process)
9208 ;;; World time
9211 (defvar anything-c-source-time-world
9212 '((name . "Time World List")
9213 (init . (lambda ()
9214 (let ((anything-buffer (anything-candidate-buffer 'global)))
9215 (with-current-buffer anything-buffer
9216 (display-time-world-display display-time-world-list)))))
9217 (candidates-in-buffer)))
9221 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
9224 (defvar anything-c-source-apt
9225 '((name . "APT")
9226 (init . anything-c-apt-init)
9227 (candidates-in-buffer)
9228 (candidate-transformer anything-c-apt-candidate-transformer)
9229 (display-to-real . anything-c-apt-display-to-real)
9230 (requires-pattern . 2)
9231 (delayed)
9232 (action
9233 ("Show package description" . anything-c-apt-cache-show)
9234 ("Install package" . anything-c-apt-install)
9235 ("Remove package" . anything-c-apt-uninstall)
9236 ("Purge package" . anything-c-apt-purge))
9237 (persistent-action . anything-c-apt-persistent-action)
9238 (persistent-help . "Show - C-u Refresh")))
9239 ;; (anything 'anything-c-source-apt)
9241 (defvar anything-c-apt-query "emacs")
9242 (defvar anything-c-apt-search-command "apt-cache search '%s'")
9243 (defvar anything-c-apt-show-command "apt-cache show '%s'")
9244 (defvar anything-c-apt-installed-packages nil)
9245 (defvar anything-c-apt-all-packages nil)
9248 (defun anything-c-apt-refresh ()
9249 "Refresh installed candidates list."
9250 (setq anything-c-apt-installed-packages nil)
9251 (setq anything-c-apt-all-packages nil)
9252 (anything-force-update))
9254 (defun anything-c-apt-persistent-action (candidate)
9255 "Persistent action for APT source."
9256 (if current-prefix-arg
9257 (anything-c-apt-refresh)
9258 (anything-c-apt-cache-show candidate)))
9260 (defun anything-c-apt-candidate-transformer (candidates)
9261 "Show installed candidates in a different color."
9262 (loop
9263 with all
9264 for cand in candidates
9265 for name = (anything-c-apt-display-to-real cand)
9266 if (member name anything-c-apt-installed-packages)
9267 collect (propertize cand 'face 'anything-apt-installed) into all
9268 else collect cand into all finally return all))
9270 (defun anything-c-apt-init ()
9271 "Initialize list of debian packages."
9272 (let ((query ""))
9273 (unless (and anything-c-apt-installed-packages
9274 anything-c-apt-all-packages)
9275 (message "Loading package list...")
9276 (setq anything-c-apt-installed-packages
9277 (with-temp-buffer
9278 (call-process-shell-command "dpkg --get-selections"
9279 nil (current-buffer))
9280 (loop for i in (split-string (buffer-string) "\n" t)
9281 collect (car (split-string i)))))
9282 (setq anything-c-apt-all-packages
9283 (with-current-buffer
9284 (anything-candidate-buffer
9285 (get-buffer-create (format "*anything-apt*")))
9286 (erase-buffer)
9287 (call-process-shell-command
9288 (format anything-c-apt-search-command query)
9289 nil (current-buffer))))
9290 (message "Loading package list done")
9291 (sit-for 0.5))))
9293 (defun anything-c-apt-display-to-real (line)
9294 "Return only name of a debian package.
9295 LINE is displayed like:
9296 package name - description."
9297 (car (split-string line " - ")))
9299 (defun anything-c-shell-command-if-needed (command)
9300 "Run shell command COMMAND to describe package.
9301 If a buffer named COMMAND already exists, just switch to it."
9302 (let ((buf (get-buffer command)))
9303 (anything-c-switch-to-buffer (get-buffer-create command))
9304 (unless buf (insert (shell-command-to-string command)))))
9306 (defun anything-c-apt-cache-show (package)
9307 "Show information on apt package PACKAGE."
9308 (anything-c-shell-command-if-needed
9309 (format anything-c-apt-show-command package)))
9311 (defun anything-c-apt-install (package)
9312 "Run 'apt-get install' shell command on PACKAGE."
9313 (anything-c-apt-generic-action :action 'install))
9315 (defun anything-c-apt-uninstall (package)
9316 "Run 'apt-get remove' shell command on PACKAGE."
9317 (anything-c-apt-generic-action :action 'uninstall))
9319 (defun anything-c-apt-purge (package)
9320 "Run 'apt-get purge' shell command on PACKAGE."
9321 (anything-c-apt-generic-action :action 'purge))
9323 (defun* anything-c-apt-generic-action (&key action)
9324 "Run 'apt-get ACTION'.
9325 Support install, remove and purge actions."
9326 (ansi-term (getenv "SHELL") "anything apt")
9327 (term-line-mode)
9328 (let ((command (case action
9329 ('install "sudo apt-get install ")
9330 ('uninstall "sudo apt-get remove ")
9331 ('purge "sudo apt-get purge ")
9332 (t (error "Unknow action"))))
9333 (beg (point))
9335 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
9336 (anything-marked-candidates) " ")))
9337 (goto-char (point-max))
9338 (insert (concat command cand-list))
9339 (setq end (point))
9340 (if (y-or-n-p (format "%s package" (symbol-name action)))
9341 (progn
9342 (setq anything-c-external-commands-list nil)
9343 (setq anything-c-apt-installed-packages nil)
9344 (term-char-mode) (term-send-input))
9345 (delete-region beg end) (term-send-eof) (kill-buffer))))
9347 ;; (anything-c-apt-install "jed")
9350 ;;; Anything UI for gentoo portage.
9353 (defvar anything-c-gentoo-use-flags nil)
9354 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9355 (defvar anything-c-cache-gentoo nil)
9356 (defvar anything-c-cache-world nil)
9357 (defvar anything-c-source-gentoo
9358 '((name . "Portage sources")
9359 (init . (lambda ()
9360 (get-buffer-create anything-c-gentoo-buffer)
9361 (unless anything-c-cache-gentoo
9362 (anything-c-gentoo-setup-cache))
9363 (unless anything-c-cache-world
9364 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9365 (anything-c-gentoo-init-list)))
9366 (candidates-in-buffer)
9367 (match . identity)
9368 (candidate-transformer anything-c-highlight-world)
9369 (action . (("Show package" . (lambda (elm)
9370 (anything-c-gentoo-eshell-action elm "eix")))
9371 ("Show history" . (lambda (elm)
9372 (if (member elm anything-c-cache-world)
9373 (anything-c-gentoo-eshell-action elm "genlop -qe")
9374 (message "No infos on packages not yet installed"))))
9375 ("Copy in kill-ring" . kill-new)
9376 ("insert at point" . insert)
9377 ("Browse HomePage" . (lambda (elm)
9378 (let ((urls (anything-c-gentoo-get-url elm)))
9379 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9380 ("Show extra infos" . (lambda (elm)
9381 (if (member elm anything-c-cache-world)
9382 (anything-c-gentoo-eshell-action elm "genlop -qi")
9383 (message "No infos on packages not yet installed"))))
9384 ("Show use flags" . (lambda (elm)
9385 (anything-c-gentoo-default-action elm "equery" "-C" "u")
9386 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9387 (font-lock-mode 1)))
9388 ("Run emerge pretend" . (lambda (elm)
9389 (anything-c-gentoo-eshell-action elm "emerge -p")))
9390 ("Emerge" . (lambda (elm)
9391 (anything-gentoo-install elm :action 'install)))
9392 ("Unmerge" . (lambda (elm)
9393 (anything-gentoo-install elm :action 'uninstall)))
9394 ("Show dependencies" . (lambda (elm)
9395 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9396 ("Show related files" . (lambda (elm)
9397 (anything-c-gentoo-default-action elm "equery" "files")))
9398 ("Refresh" . (lambda (elm)
9399 (anything-c-gentoo-setup-cache)
9400 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9402 ;; (anything 'anything-c-source-gentoo)
9404 (defun* anything-gentoo-install (candidate &key action)
9405 (setq anything-c-external-commands-list nil)
9406 (ansi-term (getenv "SHELL") "Gentoo emerge")
9407 (term-line-mode)
9408 (let ((command (case action
9409 ('install "sudo emerge -av ")
9410 ('uninstall "sudo emerge -avC ")
9411 (t (error "Unknow action"))))
9412 (elms (mapconcat 'identity (anything-marked-candidates) " "))
9413 (beg (point)) end)
9414 (goto-char (point-max))
9415 (insert (concat command elms))
9416 (setq end (point))
9417 (term-char-mode) (term-send-input)))
9419 (defun anything-c-gentoo-default-action (elm command &rest args)
9420 "Gentoo default action that use `anything-c-gentoo-buffer'."
9421 (if (member elm anything-c-cache-world)
9422 (progn
9423 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9424 (erase-buffer)
9425 (let ((com-list (append args (list elm))))
9426 (apply #'call-process command nil t nil
9427 com-list)))
9428 (message "No infos on packages not yet installed")))
9430 (defvar anything-c-source-use-flags
9431 '((name . "Use Flags")
9432 (init . (lambda ()
9433 (unless anything-c-gentoo-use-flags
9434 (anything-c-gentoo-setup-use-flags-cache))
9435 (anything-c-gentoo-get-use)))
9436 (candidates-in-buffer)
9437 (match . identity)
9438 (candidate-transformer anything-c-highlight-local-use)
9439 (action . (("Description"
9440 . (lambda (elm)
9441 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9442 (erase-buffer)
9443 (apply #'call-process "euse" nil t nil
9444 `("-i"
9445 ,elm))
9446 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9447 (font-lock-mode 1)))
9448 ("Enable"
9449 . (lambda (elm)
9450 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9451 ("Disable"
9452 . (lambda (elm)
9453 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9454 ("Remove"
9455 . (lambda (elm)
9456 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9457 ("Show which dep use this flag"
9458 . (lambda (elm)
9459 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9460 (erase-buffer)
9461 (apply #'call-process "equery" nil t nil
9462 `("-C"
9464 ,elm))))))))
9467 ;; (anything 'anything-c-source-use-flags)
9469 (defun anything-c-gentoo-init-list ()
9470 "Initialize buffer with all packages in Portage."
9471 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9472 (buf (anything-candidate-buffer 'portage-buf)))
9473 (with-current-buffer buf
9474 (dolist (i anything-c-cache-gentoo)
9475 (insert (concat i "\n"))))))
9477 (defun anything-c-gentoo-setup-cache ()
9478 "Set up `anything-c-cache-gentoo'"
9479 (setq anything-c-cache-gentoo
9480 (split-string (with-temp-buffer
9481 (call-process "eix" nil t nil
9482 "--only-names")
9483 (buffer-string)))))
9485 (defun anything-c-gentoo-eshell-action (elm command)
9486 (when (get-buffer "*EShell Command Output*")
9487 (kill-buffer "*EShell Command Output*"))
9488 (message "Wait searching...")
9489 (let ((buf-fname (buffer-file-name anything-current-buffer)))
9490 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9491 (progn
9492 (save-window-excursion
9493 (pop-to-buffer "*scratch*")
9494 (eshell-command (format "%s %s" command elm)))
9495 (pop-to-buffer "*EShell Command Output*"))
9496 (eshell-command (format "%s %s" command elm)))))
9498 (defun anything-c-gentoo-get-use ()
9499 "Initialize buffer with all use flags."
9500 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9501 (buf (anything-candidate-buffer 'use-buf)))
9502 (with-current-buffer buf
9503 (dolist (i anything-c-gentoo-use-flags)
9504 (insert (concat i "\n"))))))
9507 (defun anything-c-gentoo-setup-use-flags-cache ()
9508 "Setup `anything-c-gentoo-use-flags'"
9509 (setq anything-c-gentoo-use-flags
9510 (split-string (with-temp-buffer
9511 (call-process "eix" nil t nil
9512 "--print-all-useflags")
9513 (buffer-string)))))
9515 (defun anything-c-gentoo-get-url (elm)
9516 "Return a list of urls from eix output."
9517 (loop
9518 with url-list = (split-string
9519 (with-temp-buffer
9520 (call-process "eix" nil t nil
9521 elm "--format" "<homepage>\n")
9522 (buffer-string)))
9523 with all
9524 for i in url-list
9525 when (and (string-match "^http://.*" i)
9526 (not (member i all)))
9527 collect i into all
9528 finally return all))
9530 (defun anything-c-gentoo-get-world ()
9531 "Return list of all installed package on your system."
9532 (split-string (with-temp-buffer
9533 (call-process "qlist" nil t nil
9534 "-I")
9535 (buffer-string))))
9537 (defun anything-c-gentoo-get-local-use ()
9538 (split-string (with-temp-buffer
9539 (call-process "portageq" nil t nil
9540 "envvar"
9541 "USE")
9542 (buffer-string))))
9545 (defun anything-c-highlight-world (eix)
9546 "Highlight all installed package."
9547 (loop for i in eix
9548 if (member i anything-c-cache-world)
9549 collect (propertize i 'face 'anything-gentoo-match-face)
9550 else
9551 collect i))
9553 (defun anything-c-highlight-local-use (use-flags)
9554 (let ((local-uses (anything-c-gentoo-get-local-use)))
9555 (loop for i in use-flags
9556 if (member i local-uses)
9557 collect (propertize i 'face 'anything-gentoo-match-face)
9558 else
9559 collect i)))
9563 ;;; Anything ratpoison UI
9566 (defvar anything-c-source-ratpoison-commands
9567 '((name . "Ratpoison Commands")
9568 (init . anything-c-ratpoison-commands-init)
9569 (candidates-in-buffer)
9570 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9571 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9572 (candidate-number-limit)))
9573 ;; (anything 'anything-c-source-ratpoison-commands)
9575 (defun anything-c-ratpoison-commands-init ()
9576 (unless (anything-candidate-buffer)
9577 (with-current-buffer (anything-candidate-buffer 'global)
9578 ;; with ratpoison prefix key
9579 (save-excursion
9580 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9581 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9582 (replace-match "<ratpoison> \\1: \\2"))
9583 (goto-char (point-max))
9584 ;; direct binding
9585 (save-excursion
9586 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9587 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9588 (replace-match "\\1: \\2")))))
9590 (defun anything-c-ratpoison-commands-display-to-real (display)
9591 (and (string-match ": " display)
9592 (substring display (match-end 0))))
9594 (defun anything-c-ratpoison-commands-execute (candidate)
9595 (call-process "ratpoison" nil nil nil "-ic" candidate))
9599 ;;; Anything `completing-read' replacement
9602 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9603 "Convert COLLECTION to list removing elements that don't match TEST.
9604 SORT-FN is a predicate to sort COLLECTION.
9605 ALISTP is a flag to not use `all-completions' which doesn't handle alists correctly\
9606 for anything.
9607 If collection is an `obarray', a TEST is needed. See `obarray'."
9608 (let ((cands
9609 (cond ((and (eq collection obarray) test)
9610 (all-completions "" collection test))
9611 ((and (vectorp collection) test)
9612 (loop for i across collection when (funcall test i) collect i))
9613 ((vectorp collection)
9614 (loop for i across collection collect i))
9615 ((and alistp test)
9616 (loop for i in collection when (funcall test i) collect i))
9617 (alistp collection)
9618 ((and collection test)
9619 (all-completions "" collection test))
9620 (t (all-completions "" collection)))))
9621 (if sort-fn (sort cands sort-fn) cands)))
9623 (defun anything-cr-default-transformer (candidates source)
9624 "Default filter candidate function for `anything-comp-read'.
9625 Do nothing, just return candidate list unmodified."
9626 candidates)
9628 (defun* anything-comp-read (prompt collection
9629 &key
9630 test
9631 initial-input
9632 (buffer "*Anything Completions*")
9633 must-match
9634 (requires-pattern 0)
9635 (history nil)
9636 (persistent-action nil)
9637 (persistent-help "DoNothing")
9638 (name "Anything Completions")
9639 (volatile t)
9640 sort
9641 (fc-transformer 'anything-cr-default-transformer)
9642 (marked-candidates nil)
9643 (alistp t))
9644 "Anything `completing-read' emulation.
9645 PROMPT is the prompt name to use.
9646 COLLECTION can be a list, vector, obarray or hash-table.
9647 Keys:
9649 TEST: A predicate called with one arg i.e candidate.
9650 INITIAL-INPUT: Same as initial-input arg in `anything'.
9651 BUFFER: Name of anything-buffer.
9652 MUST-MATCH: Candidate selected must be one of COLLECTION.
9653 REQUIRES-PATTERN: Same as anything attribute, default is 0.
9654 HISTORY: A list containing specific history, default is nil.
9655 When it is non--nil, all elements of HISTORY are displayed in
9656 anything-buffer before COLLECTION.
9657 PERSISTENT-ACTION: A function called with one arg i.e candidate.
9658 PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9659 NAME: The name related to this local source.
9660 VOLATILE: Use volatile attribute.
9661 SORT: A predicate to give to `sort' e.g `string-lessp'.
9662 FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9663 MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9664 ALISTP: when non--nil \(default\) cdr of alist is returned otherwise it is the car.
9666 Any prefix args passed during `anything-comp-read' invocation will be recorded
9667 in `anything-current-prefix-arg', otherwise if prefix args where given before
9668 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9669 That's mean you can pass prefix arg before or after calling
9670 a command that use `anything-comp-read'.
9671 It support now also a function as argument, See `all-completions' for more details."
9672 (when (get-buffer anything-action-buffer)
9673 (kill-buffer anything-action-buffer))
9674 (flet ((action-fn (candidate)
9675 (if marked-candidates
9676 (anything-marked-candidates)
9677 (identity candidate))))
9678 (let ((hist `((name . ,(format "%s History" name))
9679 (candidates . (lambda ()
9680 (anything-comp-read-get-candidates
9681 history nil nil ,alistp)))
9682 (persistent-action . ,persistent-action)
9683 (persistent-help . ,persistent-help)
9684 (action . ,'action-fn)))
9685 (src `((name . ,name)
9686 (candidates
9687 . (lambda ()
9688 (let ((cands (anything-comp-read-get-candidates
9689 collection test sort alistp)))
9690 (if (or must-match (string= anything-pattern ""))
9691 cands (append (list anything-pattern) cands)))))
9692 (filtered-candidate-transformer ,fc-transformer)
9693 (requires-pattern . ,requires-pattern)
9694 (persistent-action . ,persistent-action)
9695 (persistent-help . ,persistent-help)
9696 (action . ,'action-fn))))
9697 (when volatile (setq src (append src '((volatile)))))
9698 (or (anything
9699 :sources `(,hist ,src)
9700 :input initial-input
9701 :prompt prompt
9702 :resume 'noresume
9703 :buffer buffer)
9704 (keyboard-quit)))))
9706 ;; Generic completing-read
9708 ;; Support also function as collection.
9709 ;; e.g M-x man is supported.
9710 ;; Support hash-table and vectors as collection.
9711 ;; NOTE:
9712 ;; Some crap emacs functions may not be supported
9713 ;; like ffap-alternate-file (bad use of completing-read)
9714 ;; and maybe others.
9715 ;; Provide a mode `anything-completion-mode' which turn on
9716 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9718 (defun anything-completing-read-default
9719 (prompt collection &optional
9720 predicate require-match
9721 initial-input hist def
9722 inherit-input-method)
9723 "An anything replacement of `completing-read'.
9725 Don't use it directly, use instead `anything-comp-read' in your programs \
9726 which is more powerful.
9728 See documentation of `completing-read' and `all-completions' for details."
9729 (let ((init (or def initial-input)))
9730 (anything-comp-read
9731 prompt collection
9732 :test predicate
9733 :fc-transformer #'(lambda (candidates source)
9734 (loop for i in candidates
9735 if (consp i) collect (car i)
9736 else collect i))
9737 :history (eval (or (car-safe hist) hist))
9738 :must-match require-match
9739 :alistp nil
9740 :initial-input init)))
9742 (defun anything-generic-read-file-name
9743 (prompt &optional dir default-filename mustmatch initial predicate)
9744 "An anything replacement of `read-file-name'."
9745 (let* ((default (and default-filename
9746 (if (listp default-filename)
9747 (car default-filename)
9748 default-filename)))
9749 (init (or default initial dir default-directory))
9750 (ini-input (and init (expand-file-name init)))
9751 (anything-ff-auto-update-flag nil))
9752 (anything-c-read-file-name prompt
9753 :initial-input (expand-file-name init dir)
9754 :alistp nil
9755 :must-match mustmatch
9756 :test predicate)))
9758 (defvar anything-completion-mode-string " AC")
9759 ;;;###autoload
9760 (define-minor-mode anything-completion-mode
9761 "Toggle generic anything completion.
9762 All functions in Emacs that use `completing-read'
9763 or `read-file-name' and friends will use anything interface
9764 when this mode is turned on.
9765 Called with a positive arg, turn on inconditionnaly, with a
9766 negative arg turn off.
9767 You can turn it on with `ac-mode'.
9769 Some crap emacs functions may not be supported,
9770 e.g `ffap-alternate-file' and maybe others."
9771 :group 'anything
9772 :global t
9773 :lighter anything-completion-mode-string
9774 (declare (special completing-read-function))
9775 (if anything-completion-mode
9776 (progn
9777 (setq completing-read-function 'anything-completing-read-default
9778 read-file-name-function 'anything-generic-read-file-name)
9779 (message "Anything completion enabled"))
9780 (setq completing-read-function 'completing-read-default
9781 read-file-name-function 'read-file-name-default)
9782 (message "Anything completion disabled")))
9784 (defalias 'ac-mode 'anything-completion-mode)
9788 ;;; Eshell completion.
9790 ;; Enable like this in .emacs:
9792 ;; (add-hook 'eshell-mode-hook
9793 ;; #'(lambda ()
9794 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9796 (defvar anything-c-source-esh
9797 '((name . "Eshell completions")
9798 (init . (lambda ()
9799 (setq pcomplete-current-completions nil
9800 pcomplete-last-completion-raw nil)))
9801 (candidates . anything-esh-get-candidates)
9802 (action . anything-ec-insert))
9803 "Anything source for Eshell completion.")
9805 ;; Internal.
9806 (defvar anything-ec-target "")
9807 (defun anything-ec-insert (candidate)
9808 "Insert CANDIDATE at point.
9809 This is the same as `ac-insert', just inlined here for compatibility."
9810 (let ((pt (point)))
9811 (when (and anything-ec-target
9812 (search-backward anything-ec-target nil t)
9813 (string= (buffer-substring (point) pt) anything-ec-target))
9814 (delete-region (point) pt)))
9815 (insert candidate))
9817 (defun anything-esh-get-candidates ()
9818 "Get candidates for eshell completion using `pcomplete'."
9819 (catch 'pcompleted
9820 (let* ((pcomplete-stub)
9821 pcomplete-seen pcomplete-norm-func
9822 pcomplete-args pcomplete-last pcomplete-index
9823 (pcomplete-autolist pcomplete-autolist)
9824 (pcomplete-suffix-list pcomplete-suffix-list))
9825 (with-anything-current-buffer
9826 (loop
9827 with table = (pcomplete-completions)
9828 with entry = (condition-case nil
9829 ;; For Emacs24
9830 (funcall (pcomplete-entries) anything-pattern nil nil)
9831 ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9832 (error
9834 (let ((fc (car (last (pcomplete-parse-arguments)))))
9835 ;; Check if last arg require fname completion.
9836 (and (file-name-directory fc) fc))))
9837 for i in (if (listp table) table ; Emacs23 or commands.
9838 (all-completions pcomplete-stub table)) ; Emacs24
9839 for file-cand = (and entry (expand-file-name i (file-name-directory entry)))
9840 if (and file-cand (file-exists-p file-cand)) collect file-cand into ls
9841 else collect i into ls
9842 finally return
9843 (if (and entry (not (string= entry "")) (file-exists-p entry))
9844 (append (list (expand-file-name entry default-directory)) ls) ls))))))
9846 ;;; Eshell history.
9849 (defvar anything-c-source-eshell-history
9850 '((name . "Eshell history")
9851 (init . (lambda ()
9852 (with-current-buffer (anything-candidate-buffer 'global)
9853 (insert-file-contents eshell-history-file-name))))
9854 (candidates-in-buffer)
9855 (action . (lambda (candidate)
9856 (insert candidate))))
9857 "Anything source for Eshell history.")
9860 ;;; Show completion - an alternative of anything-show-completion.el.
9862 ;; Provide show completion with macro `with-anything-show-completion'.
9865 ;; Internal
9866 (defvar anything-c-show-completion-overlay nil)
9868 ;; Called each time cursor move in anything-buffer.
9869 (defun anything-c-show-completion ()
9870 (overlay-put anything-c-show-completion-overlay
9871 'display (anything-get-selection)))
9873 (defun anything-c-show-completion-init-overlay (beg end)
9874 (and anything-c-turn-on-show-completion
9875 (setq anything-c-show-completion-overlay (make-overlay beg end))
9876 (overlay-put anything-c-show-completion-overlay
9877 'face 'anything-lisp-show-completion)))
9879 (defmacro with-anything-show-completion (beg end &rest body)
9880 "Show anything candidate in an overlay at point.
9881 BEG and END are the beginning and end position of the current completion
9882 in `anything-current-buffer'.
9883 BODY is an anything call where we want to enable show completion.
9884 If `anything-c-turn-on-show-completion' is nil just do nothing."
9885 (declare (indent 2) (debug t))
9886 `(let ((anything-move-selection-after-hook
9887 (and anything-c-turn-on-show-completion
9888 (append (list 'anything-c-show-completion)
9889 anything-move-selection-after-hook))))
9890 (unwind-protect
9891 (progn (anything-c-show-completion-init-overlay ,beg ,end)
9892 ,@body)
9893 (and anything-c-turn-on-show-completion
9894 (delete-overlay anything-c-show-completion-overlay)))))
9897 ;;; Lisp symbol completion.
9900 ;;;###autoload
9901 (defun anything-lisp-completion-at-point ()
9902 "Anything lisp symbol completion at point."
9903 (interactive)
9904 (let* ((data (lisp-completion-at-point))
9905 (beg (car data))
9906 (end (point)) ; 'cadr data' is wrong when no space after point.
9907 (plist (nthcdr 3 data))
9908 (pred (plist-get plist :predicate))
9909 (lgst-len 0)
9910 (target (and beg end (buffer-substring-no-properties beg end)))
9911 (candidates (all-completions target (nth 2 data) pred))
9912 (anything-quit-if-no-candidate t)
9913 (anything-execute-action-at-once-if-one t)
9914 (anything-match-plugin-enabled
9915 (member 'anything-compile-source--match-plugin
9916 anything-compile-source-functions)))
9917 (if candidates
9918 (with-anything-show-completion beg end
9919 ;; Overlay is initialized now in anything-current-buffer.
9920 (anything
9921 :sources
9922 '((name . "Lisp completion")
9923 (init . (lambda ()
9924 (with-current-buffer (anything-candidate-buffer 'global)
9925 (loop for sym in candidates
9926 for len = (length sym)
9927 when (> len lgst-len) do (setq lgst-len len)
9928 do (insert (concat sym "\n"))))))
9929 (candidates-in-buffer)
9930 (persistent-action . (lambda (candidate)
9931 (let ((cursor-in-echo-area t)
9932 mode-line-in-non-selected-windows)
9933 (anything-c-eldoc-show-in-mode-line
9934 (propertize
9935 (anything-c-get-first-line-documentation
9936 (intern candidate))
9937 'face 'anything-lisp-completion-info)))))
9938 (persistent-help . "Show brief doc in mode-line")
9939 (filtered-candidate-transformer anything-lisp-completion-transformer)
9940 (action . (lambda (candidate)
9941 (delete-region beg end)
9942 (insert candidate))))
9943 :input (if anything-match-plugin-enabled (concat target " ") target)))
9944 (message "[No Match]"))))
9946 (defun anything-lisp-completion-transformer (candidates source)
9947 "Anything candidates transformer for lisp completion."
9948 (declare (special lgst-len))
9949 (loop for c in candidates
9950 for sym = (intern c)
9951 for annot = (cond ((commandp sym) " (Com)")
9952 ((fboundp sym) " (Fun)")
9953 ((boundp sym) " (Var)")
9954 ((facep sym) " (Face)"))
9955 for spaces = (make-string (- lgst-len (length c)) ? )
9956 collect (cons (concat c spaces annot) c)))
9958 (defun anything-c-get-first-line-documentation (sym)
9959 "Return first line documentation of symbol SYM.
9960 If SYM is not documented, return \"Not documented\"."
9961 (let ((doc (cond ((fboundp sym)
9962 (documentation sym t))
9963 ((boundp sym)
9964 (documentation-property sym 'variable-documentation t))
9965 ((facep sym)
9966 (face-documentation sym))
9967 (t nil))))
9968 (if (and doc (not (string= doc ""))
9969 ;; `documentation' return "\n\n(args...)"
9970 ;; for CL-style functions.
9971 (not (string-match-p "^\n\n" doc)))
9972 (car (split-string doc "\n"))
9973 "Not documented")))
9975 ;;; File completion.
9977 ;; Complete file name at point.
9978 (defun anything-c-thing-before-point ()
9979 "Get symbol name before point.
9980 Borrowed from anything-complete.el, inlined here for compatibility."
9981 (save-excursion
9982 (let ((beg (point)))
9983 ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
9984 (when (re-search-backward
9985 "\\_<" (field-beginning nil nil (point-at-bol)) t)
9986 (buffer-substring-no-properties beg (match-end 0))))))
9988 ;;;###autoload
9989 (defun anything-c-complete-file-name-at-point ()
9990 "Complete file name at point."
9991 (interactive)
9992 (let* ((init (substring-no-properties (thing-at-point 'filename)))
9993 (end (point))
9994 (beg (- (point) (length init)))
9995 (anything-quit-if-no-candidate t)
9996 (anything-execute-action-at-once-if-one t)
9997 completion)
9998 (with-anything-show-completion beg end
9999 (setq completion (anything-c-read-file-name "FileName: "
10000 :initial-input init
10001 :must-match t)))
10002 (anything-c-insert-file-name-completion-at-point completion)))
10004 ;; Internal
10005 (defvar anything-lisp-completion-counter 0)
10006 ;;;###autoload
10007 (defun anything-lisp-completion-at-point-or-indent (arg)
10008 "First call indent and second call complete lisp symbol.
10009 The second call should happen before `anything-lisp-completion-or-indent-delay',
10010 after this delay, next call will indent again.
10011 After completion, next call is always indent.
10012 See that like click and double mouse click.
10013 One hit indent, two quick hits maybe indent and complete."
10014 (interactive "P")
10015 ;; Be sure `indent-for-tab-command' will not try
10016 ;; to use `completion-at-point'.
10017 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
10018 t tab-always-indent)))
10019 (incf anything-lisp-completion-counter)
10020 (unwind-protect
10021 (if (> anything-lisp-completion-counter 1)
10022 (anything-lisp-completion-or-file-name-at-point)
10023 (indent-for-tab-command arg))
10024 ;; After `anything-lisp-completion-or-indent-delay' seconds
10025 ;; reset to 0.
10026 (run-with-timer anything-lisp-completion-or-indent-delay nil
10027 #'(lambda ()
10028 (setq anything-lisp-completion-counter 0)))
10029 ;; Always reset to 0 at second hit.
10030 (when (eq anything-lisp-completion-counter 2)
10031 (setq anything-lisp-completion-counter 0)))))
10033 ;;;###autoload
10034 (defun anything-lisp-completion-or-file-name-at-point ()
10035 "Complete lisp symbol or filename at point.
10036 Filename completion happen if filename is started in
10037 or between double quotes."
10038 (interactive)
10039 (let ((tap (substring-no-properties (thing-at-point 'filename))))
10040 (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
10041 (save-excursion (search-backward "\"" (point-at-bol) t)))
10042 (anything-c-complete-file-name-at-point)
10043 (anything-lisp-completion-at-point))))
10047 ;;; Run Externals commands within Emacs with anything completion
10050 (defvar anything-external-command-history nil)
10052 (defun anything-c-external-commands-list-1 (&optional sort)
10053 "Returns a list of all external commands the user can execute.
10054 If `anything-c-external-commands-list' is non-nil it will
10055 return its contents. Else it calculates all external commands
10056 and sets `anything-c-external-commands-list'."
10057 (if anything-c-external-commands-list
10058 anything-c-external-commands-list
10059 (setq anything-c-external-commands-list
10060 (loop
10061 with paths = (split-string (getenv "PATH") path-separator)
10062 with completions = ()
10063 for dir in paths
10064 when (and (file-exists-p dir) (file-accessible-directory-p dir))
10065 for lsdir = (loop for i in (directory-files dir t)
10066 for bn = (file-name-nondirectory i)
10067 when (and (not (member bn completions))
10068 (not (file-directory-p i))
10069 (file-executable-p i))
10070 collect bn)
10071 append lsdir into completions
10072 finally return (if sort (sort completions 'string-lessp) completions)))))
10074 (defun anything-run-or-raise (exe &optional file)
10075 "Generic command that run asynchronously EXE.
10076 If EXE is already running just jump to his window if `anything-raise-command'
10077 is non--nil.
10078 When FILE argument is provided run EXE with FILE.
10079 In this case EXE must be provided as \"EXE %s\"."
10080 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
10081 "'%s'" "" exe))))
10082 (proc (if file (concat real-com " " file) real-com)))
10083 (if (get-process proc)
10084 (if anything-raise-command
10085 (shell-command (format anything-raise-command real-com))
10086 (error "Error: %s is already running" real-com))
10087 (when (loop for i in anything-c-external-commands-list thereis real-com)
10088 (message "Starting %s..." real-com)
10089 (if file
10090 (start-process-shell-command proc nil (format exe file))
10091 (start-process-shell-command proc nil real-com))
10092 (set-process-sentinel
10093 (get-process proc)
10094 #'(lambda (process event)
10095 (when (and (string= event "finished\n")
10096 anything-raise-command
10097 (not (anything-c-get-pid-from-process-name real-com)))
10098 (shell-command (format anything-raise-command "emacs")))
10099 (message "%s process...Finished." process))))
10100 (setq anything-c-external-commands-list
10101 (cons real-com
10102 (delete real-com anything-c-external-commands-list))))))
10106 ;;; Generic action functions
10109 (defun anything-c-file-buffers (filename)
10110 "Returns a list of buffer names corresponding to FILENAME."
10111 (let ((name (expand-file-name filename))
10112 (buf-list ()))
10113 (dolist (buf (buffer-list) buf-list)
10114 (let ((bfn (buffer-file-name buf)))
10115 (when (and bfn (string= name bfn))
10116 (push (buffer-name buf) buf-list))))))
10118 (defun anything-revert-buffer (candidate)
10119 (with-current-buffer candidate
10120 (when (or (buffer-modified-p)
10121 (not (verify-visited-file-modtime
10122 (get-buffer candidate))))
10123 (revert-buffer t t))))
10125 (defun anything-revert-marked-buffers (ignore)
10126 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10128 (defun anything-kill-marked-buffers (ignore)
10129 (mapc 'kill-buffer (anything-marked-candidates)))
10131 (defun anything-c-delete-file (file)
10132 "Delete the given file after querying the user.
10133 Ask to kill buffers associated with that file, too."
10134 (let ((buffers (anything-c-file-buffers file)))
10135 (if (< emacs-major-version 24)
10136 ;; `dired-delete-file' in Emacs versions < 24
10137 ;; doesn't support delete-by-moving-to-trash
10138 ;; so use `delete-directory' and `delete-file'
10139 ;; that handle it.
10140 (cond ((and (not (file-symlink-p file))
10141 (file-directory-p file)
10142 (directory-files file t dired-re-no-dot))
10143 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
10144 (delete-directory file 'recursive)))
10145 ((and (not (file-symlink-p file))
10146 (file-directory-p file))
10147 (delete-directory file))
10148 (t (delete-file file)))
10149 (dired-delete-file
10150 file 'dired-recursive-deletes delete-by-moving-to-trash))
10151 (when buffers
10152 (dolist (buf buffers)
10153 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
10154 (kill-buffer buf))))))
10156 (defun anything-get-mailcap-for-file (filename)
10157 "Get the command to use for FILENAME from mailcap files.
10158 The command is like <command %s> and is meant to use with `format'."
10159 (mailcap-parse-mailcaps)
10160 (let* ((ext (file-name-extension filename))
10161 (mime (when ext (mailcap-extension-to-mime ext)))
10162 (result (when mime (mailcap-mime-info mime))))
10163 ;; If elisp file have no associations in .mailcap
10164 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
10165 (when (stringp result) result)))
10167 (defun anything-get-default-program-for-file (filename)
10168 "Try to find a default program to open FILENAME.
10169 Try first in `anything-c-external-programs-associations' and then in mailcap file
10170 if nothing found return nil."
10171 (let* ((ext (file-name-extension filename))
10172 (def-prog (assoc-default ext anything-c-external-programs-associations)))
10173 (cond ((and def-prog (not (string= def-prog "")))
10174 (concat def-prog " %s"))
10175 ((and anything-c-default-external-file-browser
10176 (file-directory-p filename))
10177 (concat anything-c-default-external-file-browser " %s"))
10178 (t (anything-get-mailcap-for-file filename)))))
10180 (defun anything-c-open-file-externally (file)
10181 "Open FILE with an external program.
10182 Try to guess which program to use with `anything-get-default-program-for-file'.
10183 If not found or a prefix arg is given query the user which tool to use."
10184 (let* ((fname (expand-file-name file))
10185 (collection (anything-c-external-commands-list-1 'sort))
10186 (def-prog (anything-get-default-program-for-file fname))
10187 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
10188 ;; Prefix arg or no default program.
10189 (prog1
10190 (anything-comp-read
10191 "Program: " collection
10192 :must-match t
10193 :name "Open file Externally"
10194 :history anything-external-command-history)
10195 ;; Always prompt to set this program as default.
10196 (setq def-prog nil))
10197 ;; No prefix arg or default program exists.
10198 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
10199 (program (concat real-prog-name " '%s'")))
10200 (unless (or def-prog ; Association exists, no need to record it.
10201 ;; Don't try to record non--filenames associations (e.g urls).
10202 (not (file-exists-p fname)))
10203 (when
10204 (y-or-n-p
10205 (format
10206 "Do you want to make `%s' the default program for this kind of files? "
10207 real-prog-name))
10208 (anything-aif (assoc (file-name-extension fname)
10209 anything-c-external-programs-associations)
10210 (setq anything-c-external-programs-associations
10211 (delete it anything-c-external-programs-associations)))
10212 (push (cons (file-name-extension fname)
10213 (read-string
10214 "Program (Add args maybe and confirm): " real-prog-name))
10215 anything-c-external-programs-associations)
10216 (customize-save-variable 'anything-c-external-programs-associations
10217 anything-c-external-programs-associations)))
10218 (anything-run-or-raise program file)
10219 (setq anything-external-command-history
10220 (cons real-prog-name
10221 (delete real-prog-name
10222 (loop for i in anything-external-command-history
10223 when (executable-find i) collect i))))))
10226 (defun anything-c-find-file-or-marked (candidate)
10227 "Open file CANDIDATE or open anything marked files in background."
10228 (let ((marked (anything-marked-candidates))
10229 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10230 (find-file-wildcards nil))
10231 (if (> (length marked) 1)
10232 ;; Open all marked files in background and display
10233 ;; the first one.
10234 (progn (mapc 'find-file-noselect (cdr marked))
10235 (find-file (car marked)))
10236 (if (and (not (file-exists-p candidate))
10237 (and ffap-url-regexp
10238 (not (string-match ffap-url-regexp candidate)))
10239 (string-match "/$" candidate))
10240 ;; A a non--existing filename ending with /
10241 ;; Create a directory and jump to it.
10242 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10243 (let ((dirfname (directory-file-name candidate)))
10244 (if (file-exists-p dirfname)
10245 (error "Mkdir: Unable to create directory `%s': file exists."
10246 (anything-c-basename dirfname))
10247 (make-directory candidate 'parent)))
10248 (anything-find-files-1 candidate))
10249 ;; A non--existing filename NOT ending with / or
10250 ;; an existing filename, create or jump to it.
10251 (find-file-at-point (car marked))))))
10253 (defun anything-delete-marked-files (ignore)
10254 (let* ((files (anything-marked-candidates))
10255 (len (length files)))
10256 (if (not (y-or-n-p
10257 (format "Delete *%s File(s):\n%s"
10259 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10260 (message "(No deletions performed)")
10261 (dolist (i files)
10262 (set-text-properties 0 (length i) nil i)
10263 (anything-c-delete-file i))
10264 (message "%s File(s) deleted" len))))
10266 (defun anything-ediff-marked-buffers (candidate &optional merge)
10267 "Ediff 2 marked buffers or CANDIDATE and `anything-current-buffer'.
10268 With optional arg MERGE call `ediff-merge-buffers'."
10269 (let ((lg-lst (length (anything-marked-candidates)))
10270 buf1 buf2)
10271 (case lg-lst
10273 (error "Error:You have to mark at least 1 buffer"))
10275 (setq buf1 anything-current-buffer
10276 buf2 (first (anything-marked-candidates))))
10278 (setq buf1 (first (anything-marked-candidates))
10279 buf2 (second (anything-marked-candidates))))
10281 (error "Error:To much buffers marked!")))
10282 (if merge
10283 (ediff-merge-buffers buf1 buf2)
10284 (ediff-buffers buf1 buf2))))
10286 (defun anything-ediff-marked-buffers-merge (candidate)
10287 "Ediff merge `anything-current-buffer' with CANDIDATE.
10288 See `anything-ediff-marked-buffers'."
10289 (anything-ediff-marked-buffers candidate t))
10291 (defun anything-bookmark-get-bookmark-from-name (bmk)
10292 "Return bookmark name even if it is a bookmark with annotation.
10293 e.g prepended with *.
10294 Return nil if bmk is not a valid bookmark."
10295 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10296 (if (assoc bookmark bookmark-alist)
10297 bookmark
10298 (when (assoc bmk bookmark-alist)
10299 bmk))))
10301 (defun anything-delete-marked-bookmarks (ignore)
10302 "Delete this bookmark or all marked bookmarks."
10303 (dolist (i (anything-marked-candidates))
10304 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10305 'batch)))
10307 (defun anything-require-or-error (feature function)
10308 (or (require feature nil t)
10309 (error "Need %s to use `%s'." feature function)))
10311 (defun anything-find-buffer-on-elscreen (candidate)
10312 "Open buffer in new screen, if marked buffers open all in elscreens."
10313 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10314 (anything-aif (anything-marked-candidates)
10315 (dolist (i it)
10316 (let ((target-screen (elscreen-find-screen-by-buffer
10317 (get-buffer i) 'create)))
10318 (elscreen-goto target-screen)))
10319 (let ((target-screen (elscreen-find-screen-by-buffer
10320 (get-buffer candidate) 'create)))
10321 (elscreen-goto target-screen))))
10323 (defun anything-elscreen-find-file (file)
10324 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10325 (elscreen-find-file file))
10327 ;;;###autoload
10328 (defun w32-shell-execute-open-file (file)
10329 (interactive "fOpen file:")
10330 (with-no-warnings
10331 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
10332 "/" "\\"
10333 (replace-regexp-in-string ; strip cygdrive paths
10334 "/cygdrive/\\(.\\)" "\\1:"
10335 file nil nil) nil t))))
10337 (defun anything-c-open-file-with-default-tool (file)
10338 "Open FILE with the default tool on this platform."
10339 (if (eq system-type 'windows-nt)
10340 (w32-shell-execute-open-file file)
10341 (start-process "anything-c-open-file-with-default-tool"
10343 (cond ((eq system-type 'gnu/linux)
10344 "xdg-open")
10345 ((or (eq system-type 'darwin) ;; Mac OS X
10346 (eq system-type 'macos)) ;; Mac OS 9
10347 "open"))
10348 file)))
10350 (defun anything-c-open-dired (file)
10351 "Opens a dired buffer in FILE's directory. If FILE is a
10352 directory, open this directory."
10353 (if (file-directory-p file)
10354 (dired file)
10355 (dired (file-name-directory file))
10356 (dired-goto-file file)))
10358 (defun anything-c-display-to-real-line (candidate)
10359 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
10360 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
10361 (error "Line number not found")))
10363 (defun anything-c-action-line-goto (lineno-and-content)
10364 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
10365 (append lineno-and-content
10366 (list (if (and (anything-attr-defined 'target-file)
10367 (not anything-in-persistent-action))
10368 'find-file-other-window
10369 'find-file)))))
10371 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
10372 (apply #'anything-goto-file-line
10373 (if (stringp file-line-content)
10374 ;; Case: filtered-candidate-transformer is skipped
10375 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
10376 file-line-content)))
10378 (require 'compile)
10379 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
10380 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
10382 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
10383 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
10384 (let ((filename (match-string 1 candidate))
10385 (lineno (match-string 2 candidate))
10386 (content (match-string 3 candidate)))
10387 (cons (format "%s:%s\n %s"
10388 (propertize filename 'face compilation-info-face)
10389 (propertize lineno 'face compilation-line-face)
10390 content)
10391 (list (expand-file-name
10392 filename
10393 (or (anything-interpret-value (anything-attr 'default-directory))
10394 (and (anything-candidate-buffer)
10395 (buffer-local-value
10396 'default-directory (anything-candidate-buffer)))))
10397 (string-to-number lineno) content)))))
10399 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10400 (anything-aif (anything-attr 'before-jump-hook)
10401 (funcall it))
10402 (when file (funcall find-file-function file))
10403 (if (anything-attr-defined 'adjust)
10404 (anything-c-goto-line-with-adjustment lineno content)
10405 (anything-goto-line lineno))
10406 (unless (anything-attr-defined 'recenter)
10407 (set-window-start (get-buffer-window anything-current-buffer) (point)))
10408 (anything-aif (anything-attr 'after-jump-hook)
10409 (funcall it))
10410 (when anything-in-persistent-action
10411 (anything-match-line-color-current-line)))
10413 (defun anything-find-file-as-root (candidate)
10414 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10416 (defun anything-find-many-files (ignore)
10417 (mapc 'find-file (anything-marked-candidates)))
10419 ;; borrowed from etags.el
10420 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10421 (defun anything-c-goto-line-with-adjustment (line line-content)
10422 (let ((startpos)
10423 offset found pat)
10424 ;; This constant is 1/2 the initial search window.
10425 ;; There is no sense in making it too small,
10426 ;; since just going around the loop once probably
10427 ;; costs about as much as searching 2000 chars.
10428 (setq offset 1000
10429 found nil
10430 pat (concat (if (eq selective-display t)
10431 "\\(^\\|\^m\\) *" "^ *") ;allow indent
10432 (regexp-quote line-content)))
10433 ;; If no char pos was given, try the given line number.
10434 (setq startpos (progn (anything-goto-line line) (point)))
10435 (or startpos (setq startpos (point-min)))
10436 ;; First see if the tag is right at the specified location.
10437 (goto-char startpos)
10438 (setq found (looking-at pat))
10439 (while (and (not found)
10440 (progn
10441 (goto-char (- startpos offset))
10442 (not (bobp))))
10443 (setq found
10444 (re-search-forward pat (+ startpos offset) t)
10445 offset (* 3 offset))) ; expand search window
10446 (or found
10447 (re-search-forward pat nil t)
10448 (error "not found")))
10449 ;; Position point at the right place
10450 ;; if the search string matched an extra Ctrl-m at the beginning.
10451 (and (eq selective-display t)
10452 (looking-at "\^m")
10453 (forward-char 1))
10454 (beginning-of-line))
10456 (anything-document-attribute 'default-directory "type . file-line"
10457 "`default-directory' to interpret file.")
10458 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10459 "Function to call before jumping to the target location.")
10460 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10461 "Function to call after jumping to the target location.")
10462 (anything-document-attribute 'adjust "type . file-line"
10463 "Search around line matching line contents.")
10464 (anything-document-attribute 'recenter "type . file-line / line"
10465 "`recenter' after jumping.")
10466 (anything-document-attribute 'target-file "type . line"
10467 "Goto line of target-file.")
10469 ;;;###autoload
10470 (defun anything-c-call-interactively (cmd-or-name)
10471 "Execute CMD-OR-NAME as Emacs command.
10472 It is added to `extended-command-history'.
10473 `anything-current-prefix-arg' is used as the command's prefix argument."
10474 (setq extended-command-history
10475 (cons (anything-c-stringify cmd-or-name)
10476 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10477 (let ((current-prefix-arg anything-current-prefix-arg)
10478 (cmd (anything-c-symbolify cmd-or-name)))
10479 (if (stringp (symbol-function cmd))
10480 (execute-kbd-macro (symbol-function cmd))
10481 (setq this-command cmd)
10482 (call-interactively cmd))))
10484 ;;;###autoload
10485 (defun anything-c-set-variable (var)
10486 "Set value to VAR interactively."
10487 (interactive)
10488 (let ((sym (anything-c-symbolify var)))
10489 (set sym (eval-minibuffer (format "Set %s: " var)
10490 (prin1-to-string (symbol-value sym))))))
10491 ;; (setq hh 12)
10492 ;; (anything-c-set-variable 'hh)
10496 ;;; Persistent Action Helpers
10499 (defvar anything-match-line-overlay-face nil)
10500 (defvar anything-match-line-overlay nil)
10502 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10503 "Highlight and underline current position"
10504 (let ((args (list (or start (line-beginning-position))
10505 (or end (1+ (line-end-position)))
10506 buf)))
10507 (if (not anything-match-line-overlay)
10508 (setq anything-match-line-overlay (apply 'make-overlay args))
10509 (apply 'move-overlay anything-match-line-overlay args)))
10510 (overlay-put anything-match-line-overlay
10511 'face (or face anything-match-line-overlay-face))
10512 (when rec
10513 (goto-char start)
10514 (recenter)))
10516 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10519 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10521 (defun anything-match-line-cleanup ()
10522 (when anything-match-line-overlay
10523 (delete-overlay anything-match-line-overlay)
10524 (setq anything-match-line-overlay nil)))
10526 (defun anything-match-line-update ()
10527 (when anything-match-line-overlay
10528 (delete-overlay anything-match-line-overlay)
10529 (anything-match-line-color-current-line)))
10531 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10532 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10535 ;;; Actions Transformers
10538 ;;; Files
10539 (defun anything-c-transform-file-load-el (actions candidate)
10540 "Add action to load the file CANDIDATE if it is an emacs lisp
10541 file. Else return ACTIONS unmodified."
10542 (if (member (file-name-extension candidate) '("el" "elc"))
10543 (append actions '(("Load Emacs Lisp File" . load-file)))
10544 actions))
10546 (defun anything-c-transform-file-browse-url (actions candidate)
10547 "Add an action to browse the file CANDIDATE if it in a html
10548 file or URL. Else return ACTIONS unmodified."
10549 (let ((browse-action '("Browse with Browser" . browse-url)))
10550 (cond ((string-match "^http\\|^ftp" candidate)
10551 (cons browse-action actions))
10552 ((string-match "\\.html?$" candidate)
10553 (append actions (list browse-action)))
10554 (t actions))))
10556 ;;; Function
10557 (defun anything-c-transform-function-call-interactively (actions candidate)
10558 "Add an action to call the function CANDIDATE interactively if
10559 it is a command. Else return ACTIONS unmodified."
10560 (if (commandp (intern-soft candidate))
10561 (append actions '(("Call Interactively"
10563 anything-c-call-interactively)))
10564 actions))
10566 ;;;; S-Expressions
10567 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10568 "If CANDIDATE's `car' is a command, then add an action to
10569 evaluate it and put it onto the `command-history'."
10570 (if (commandp (car (read candidate)))
10571 ;; Make it first entry
10572 (cons '("Eval and put onto command-history" .
10573 (lambda (sexp)
10574 (let ((sym (read sexp)))
10575 (eval sym)
10576 (setq command-history
10577 (cons sym command-history)))))
10578 actions)
10579 actions))
10582 ;;; Candidate Transformers
10585 ;;; Buffers
10586 (defun anything-c-skip-boring-buffers (buffers)
10587 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10589 (defun anything-c-skip-current-buffer (buffers)
10590 (if anything-allow-skipping-current-buffer
10591 (remove (buffer-name anything-current-buffer) buffers)
10592 buffers))
10594 (defun anything-c-shadow-boring-buffers (buffers)
10595 "Buffers matching `anything-c-boring-buffer-regexp' will be
10596 displayed with the `file-name-shadow' face if available."
10597 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10599 (defvar anything-c-buffer-display-string-functions
10600 '(anything-c-buffer-display-string--compilation
10601 anything-c-buffer-display-string--shell
10602 anything-c-buffer-display-string--eshell)
10603 "Functions to setup display string for buffer.
10605 Function has one argument, buffer name.
10606 If it returns string, use it.
10607 If it returns nil, display buffer name.
10608 See `anything-c-buffer-display-string--compilation' for example.")
10610 (defun anything-c-transform-buffer-display-string (buffers)
10611 "Setup display string for buffer candidates
10612 using `anything-c-buffer-display-string-functions'."
10613 (loop for buf in buffers
10614 if (consp buf)
10615 collect buf
10616 else
10617 for disp = (progn (set-buffer buf)
10618 (run-hook-with-args-until-success
10619 'anything-c-buffer-display-string-functions buf))
10620 collect (if disp (cons disp buf) buf)))
10622 (defun anything-c-buffer-display-string--compilation (buf)
10623 (anything-aif (car compilation-arguments)
10624 (format "%s: %s [%s]" buf it default-directory)))
10626 (defun anything-c-buffer-display-string--eshell (buf)
10627 (declare (special eshell-history-ring))
10628 (when (eq major-mode 'eshell-mode)
10629 (format "%s: %s [%s]" buf
10630 (ignore-errors (ring-ref eshell-history-ring 0))
10631 default-directory)))
10633 (defun anything-c-buffer-display-string--shell (buf)
10634 (when (eq major-mode 'shell-mode)
10635 (format "%s: %s [%s]" buf
10636 (ignore-errors (ring-ref comint-input-ring 0))
10637 default-directory)))
10639 ;;; Files
10640 (defun anything-c-shadow-boring-files (files)
10641 "Files matching `anything-c-boring-file-regexp' will be
10642 displayed with the `file-name-shadow' face if available."
10643 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10645 (defun anything-c-skip-boring-files (files)
10646 "Files matching `anything-c-boring-file-regexp' will be skipped."
10647 (anything-c-skip-entries files anything-c-boring-file-regexp))
10648 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10650 (defun anything-c-skip-current-file (files)
10651 "Current file will be skipped."
10652 (remove (buffer-file-name anything-current-buffer) files))
10654 (defun anything-c-w32-pathname-transformer (args)
10655 "Change undesirable features of windows pathnames to ones more acceptable to
10656 other candidate transformers."
10657 (if (eq system-type 'windows-nt)
10658 (mapcar (lambda (x)
10659 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10660 (mapcar (lambda (y)
10661 (replace-regexp-in-string "\\\\" "/" y)) args))
10662 args))
10664 (defun anything-c-shorten-home-path (files)
10665 "Replaces /home/user with ~."
10666 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10667 (getenv "HOME"))))
10668 (mapcar (lambda (file)
10669 (if (and (stringp file) (string-match home file))
10670 (cons (replace-match "~" nil nil file) file)
10671 file))
10672 files)))
10674 ;;; Functions
10675 (defun anything-c-mark-interactive-functions (functions)
10676 "Mark interactive functions (commands) with (i) after the function name."
10677 (let (list)
10678 (loop for function in functions
10679 do (push (cons (concat function
10680 (when (commandp (intern-soft function)) " (i)"))
10681 function)
10682 list)
10683 finally (return (nreverse list)))))
10686 ;;; Adaptive Sorting of Candidates
10689 ;; Internal
10690 (defvar anything-c-adaptive-done nil
10691 "nil if history information is not yet stored for the current
10692 selection.")
10694 (defvar anything-c-adaptive-history nil
10695 "Contains the stored history information.
10696 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10698 (defadvice anything-initial-setup (before anything-c-adaptive-initialize activate)
10699 "Reset `anything-c-adaptive-done' when anything is started."
10700 (when anything-c-use-adaptative-sorting
10701 (setq anything-c-adaptive-done nil)))
10703 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10704 "Store history information when action is executed on selected candidate."
10705 (when anything-c-use-adaptative-sorting
10706 (anything-c-adaptive-store-selection)))
10708 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10709 "Store history information when the user goes to the action buffer."
10710 (when anything-c-use-adaptative-sorting
10711 (anything-c-adaptive-store-selection)))
10713 (defun anything-c-source-use-adaptative-p (&optional source-name)
10714 "Return current source only if it use adaptative history, nil otherwise."
10715 (when anything-c-use-adaptative-sorting
10716 (let* ((source (or source-name (anything-get-current-source)))
10717 (adapt-source (or (assoc-default 'filtered-candidate-transformer
10718 (assoc (assoc-default 'type source)
10719 anything-type-attributes))
10720 (assoc-default 'candidate-transformer
10721 (assoc (assoc-default 'type source)
10722 anything-type-attributes))
10723 (assoc-default 'filtered-candidate-transformer source)
10724 (assoc-default 'candidate-transformer source))))
10725 (if (listp adapt-source)
10726 (when (member 'anything-c-adaptive-sort adapt-source) source)
10727 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10729 (defun anything-c-adaptive-store-selection ()
10730 "Store history information for the selected candidate."
10731 (unless anything-c-adaptive-done
10732 (setq anything-c-adaptive-done t)
10733 (let ((source (anything-c-source-use-adaptative-p)))
10734 (when source
10735 (let* ((source-name (or (assoc-default 'type source)
10736 (assoc-default 'name source)))
10737 (source-info (or (assoc source-name anything-c-adaptive-history)
10738 (progn
10739 (push (list source-name) anything-c-adaptive-history)
10740 (car anything-c-adaptive-history))))
10741 (selection (anything-get-selection))
10742 (selection-info (progn
10743 (setcdr source-info
10744 (cons
10745 (let ((found (assoc selection (cdr source-info))))
10746 (if (not found)
10747 ;; new entry
10748 (list selection)
10750 ;; move entry to the beginning of the
10751 ;; list, so that it doesn't get
10752 ;; trimmed when the history is
10753 ;; truncated
10754 (setcdr source-info
10755 (delete found (cdr source-info)))
10756 found))
10757 (cdr source-info)))
10758 (cadr source-info)))
10759 (pattern-info (progn
10760 (setcdr selection-info
10761 (cons
10762 (let ((found (assoc anything-pattern (cdr selection-info))))
10763 (if (not found)
10764 ;; new entry
10765 (cons anything-pattern 0)
10767 ;; move entry to the beginning of the
10768 ;; list, so if two patterns used the
10769 ;; same number of times then the one
10770 ;; used last appears first in the list
10771 (setcdr selection-info
10772 (delete found (cdr selection-info)))
10773 found))
10774 (cdr selection-info)))
10775 (cadr selection-info))))
10777 ;; increase usage count
10778 (setcdr pattern-info (1+ (cdr pattern-info)))
10780 ;; truncate history if needed
10781 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10782 (setcdr selection-info
10783 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10785 (defun anything-c-adaptative-maybe-load-history ()
10786 (when (and anything-c-use-adaptative-sorting
10787 (file-readable-p anything-c-adaptive-history-file))
10788 (load-file anything-c-adaptive-history-file)))
10790 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10791 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10793 (defun anything-c-adaptive-save-history (&optional arg)
10794 "Save history information to file given by `anything-c-adaptive-history-file'."
10795 (interactive "p")
10796 (when anything-c-use-adaptative-sorting
10797 (with-temp-buffer
10798 (insert
10799 ";; -*- mode: emacs-lisp -*-\n"
10800 ";; History entries used for anything adaptive display.\n")
10801 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10802 (current-buffer))
10803 (insert ?\n)
10804 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10805 (unless arg 'quiet)))))
10807 (defun anything-c-adaptive-sort (candidates source)
10808 "Sort the CANDIDATES for SOURCE by usage frequency.
10809 This is a filtered candidate transformer you can use for the
10810 attribute `filtered-candidate-transformer' of a source in
10811 `anything-sources' or a type in `anything-type-attributes'."
10812 (let* ((source-name (or (assoc-default 'type source)
10813 (assoc-default 'name source)))
10814 (source-info (assoc source-name anything-c-adaptive-history)))
10815 (if source-info
10816 (let ((usage
10817 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10818 ;; pairs
10819 (mapcar (lambda (candidate-info)
10820 (let ((count 0))
10821 (dolist (pattern-info (cdr candidate-info))
10822 (if (not (equal (car pattern-info)
10823 anything-pattern))
10824 (incf count (cdr pattern-info))
10826 ;; if current pattern is equal to the previously
10827 ;; used one then this candidate has priority
10828 ;; (that's why its count is boosted by 10000) and
10829 ;; it only has to compete with other candidates
10830 ;; which were also selected with the same pattern
10831 (setq count (+ 10000 (cdr pattern-info)))
10832 (return)))
10833 (cons (car candidate-info) count)))
10834 (cdr source-info)))
10835 sorted)
10836 (if (and usage (consp usage))
10837 ;; sort the list in descending order, so candidates with highest
10838 ;; priorty come first
10839 (progn
10840 (setq usage (sort usage (lambda (first second)
10841 (> (cdr first) (cdr second)))))
10843 ;; put those candidates first which have the highest usage count
10844 (dolist (info usage)
10845 (when (member* (car info) candidates
10846 :test 'anything-c-adaptive-compare)
10847 (push (car info) sorted)
10848 (setq candidates (remove* (car info) candidates
10849 :test 'anything-c-adaptive-compare))))
10851 ;; and append the rest
10852 (append (reverse sorted) candidates nil))
10853 (message "Your `%s' is maybe corrupted or too old, \
10854 you should reinitialize it with `anything-c-reset-adaptative-history'"
10855 anything-c-adaptive-history-file)
10856 (sit-for 1)
10857 candidates))
10858 ;; if there is no information stored for this source then do nothing
10859 candidates)))
10861 ;;;###autoload
10862 (defun anything-c-reset-adaptative-history ()
10863 "Delete all `anything-c-adaptive-history' and his file.
10864 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
10865 (interactive)
10866 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
10867 (setq anything-c-adaptive-history nil)
10868 (delete-file anything-c-adaptive-history-file)))
10870 (defun anything-c-adaptive-compare (x y)
10871 "Compare candidates X and Y taking into account that the
10872 candidate can be in (DISPLAY . REAL) format."
10873 (equal (if (listp x)
10874 (cdr x)
10876 (if (listp y)
10877 (cdr y)
10878 y)))
10882 ;;; Outliner
10885 (defvar anything-outline-goto-near-line-flag t)
10886 (defvar anything-outline-using nil)
10887 (defun anything-after-update-hook--outline ()
10888 (if (and (eq anything-outline-using t)
10889 (eq anything-outline-goto-near-line-flag t))
10890 (anything-outline-goto-near-line)))
10891 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
10893 (defun anything-outline-goto-near-line ()
10894 (with-anything-window
10895 ;; TODO need consideration whether to update position by every input.
10896 (when t ; (equal anything-pattern "")
10897 (anything-goto-line 2)
10898 (let ((lineno (with-anything-current-buffer
10899 (line-number-at-pos (car anything-current-position)))))
10900 (block exit
10901 (while (<= (progn (skip-chars-forward " ")
10902 (or (number-at-point) lineno))
10903 lineno)
10904 (forward-line 1)
10905 (when (eobp)
10906 (forward-line -1)
10907 (return-from exit))))
10908 (forward-line -1)
10909 (and (bobp) (forward-line 1))
10910 (and (anything-pos-header-line-p) (forward-line -2))
10911 (anything-mark-current-line)))))
10915 ;;; Plug-in
10918 ;; Plug-in: info-index
10919 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
10920 (let (result)
10921 (unless (anything-candidate-buffer)
10922 (save-window-excursion
10923 (info file)
10924 (let (Info-history
10925 (tobuf (anything-candidate-buffer 'global))
10926 (infobuf (current-buffer))
10927 s e)
10928 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
10929 (Info-goto-node node)
10930 (goto-char (point-min))
10931 (while (search-forward "\n* " nil t)
10932 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
10933 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
10934 (setq s (point-at-bol)
10935 e (point-at-eol))
10936 (with-current-buffer tobuf
10937 (insert-buffer-substring infobuf s e)
10938 (insert "\n"))))))))))
10940 (defun anything-c-info-goto (node-line)
10941 (Info-goto-node (car node-line))
10942 (anything-goto-line (cdr node-line)))
10944 (defun anything-c-info-display-to-real (line)
10945 (and (string-match
10946 ;; This regexp is stolen from Info-apropos-matches
10947 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
10948 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
10949 (string-to-number (or (match-string 3 line) "1")))))
10951 (defun anything-c-make-info-source (source file)
10952 `(,@source
10953 (name . ,(concat "Info Index: " file))
10954 (info-file . ,file)
10955 (init . anything-c-info-init)
10956 (display-to-real . anything-c-info-display-to-real)
10957 (get-line . buffer-substring)
10958 (candidates-in-buffer)
10959 (action ("Goto node" . anything-c-info-goto))))
10961 (defun anything-compile-source--info-index (source)
10962 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
10963 (anything-c-make-info-source source it)
10964 source))
10965 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
10967 (anything-document-attribute 'info-index "info-index plugin"
10968 "Create a source of info index very easily.
10970 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
10972 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
10973 "Index nodes of info file.
10975 If it is omitted, `Info-index-nodes' is used to collect index nodes.
10976 Some info files are missing index specification.
10978 ex. See `anything-c-source-info-screen'.")
10980 ;; Plug-in: candidates-file
10981 (defun anything-compile-source--candidates-file (source)
10982 (if (assoc-default 'candidates-file source)
10983 `((init anything-p-candidats-file-init
10984 ,@(let ((orig-init (assoc-default 'init source)))
10985 (cond ((null orig-init) nil)
10986 ((functionp orig-init) (list orig-init))
10987 (t orig-init))))
10988 (candidates-in-buffer)
10989 ,@source)
10990 source))
10991 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
10993 (defun anything-p-candidats-file-init ()
10994 (destructuring-bind (file &optional updating)
10995 (anything-mklist (anything-attr 'candidates-file))
10996 (setq file (anything-interpret-value file))
10997 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
10998 (when updating
10999 (buffer-disable-undo)
11000 (font-lock-mode -1)
11001 (auto-revert-mode 1)))))
11003 (anything-document-attribute 'candidates-file "candidates-file plugin"
11004 "Use a file as the candidates buffer.
11006 1st argument is a filename, string or function name or variable name.
11007 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
11009 ;; Plug-in: headline
11010 (defun anything-compile-source--anything-headline (source)
11011 (if (assoc-default 'headline source)
11012 (append '((init . anything-headline-init)
11013 (get-line . buffer-substring)
11014 (type . line))
11015 source
11016 '((candidates-in-buffer)
11017 (persistent-help . "Show this line")))
11018 source))
11019 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
11021 (defun anything-headline-init ()
11022 (when (and (anything-current-buffer-is-modified)
11023 (with-anything-current-buffer
11024 (eval (or (anything-attr 'condition) t))))
11025 (anything-headline-make-candidate-buffer
11026 (anything-interpret-value (anything-attr 'headline))
11027 (anything-interpret-value (anything-attr 'subexp)))))
11029 (anything-document-attribute 'headline "Headline plug-in"
11030 "Regexp string for anything-headline to scan.")
11031 (anything-document-attribute 'condition "Headline plug-in"
11032 "A sexp representing the condition to use anything-headline.")
11033 (anything-document-attribute 'subexp "Headline plug-in"
11034 "Display (match-string-no-properties subexp).")
11037 (defun anything-headline-get-candidates (regexp subexp)
11038 (with-anything-current-buffer
11039 (save-excursion
11040 (goto-char (point-min))
11041 (if (functionp regexp) (setq regexp (funcall regexp)))
11042 (let (hierarchy curhead)
11043 (flet ((matched ()
11044 (if (numberp subexp)
11045 (cons (match-string-no-properties subexp) (match-beginning subexp))
11046 (cons (buffer-substring (point-at-bol) (point-at-eol))
11047 (point-at-bol))))
11048 (hierarchies (headlines)
11049 (1+ (loop for (_ . hierarchy) in headlines
11050 maximize hierarchy)))
11051 (vector-0-n (v n)
11052 (loop for i from 0 to hierarchy
11053 collecting (aref curhead i)))
11054 (arrange (headlines)
11055 (unless (null headlines) ; FIX headlines empty bug!
11056 (loop with curhead = (make-vector (hierarchies headlines) "")
11057 for ((str . pt) . hierarchy) in headlines
11058 do (aset curhead hierarchy str)
11059 collecting
11060 (cons
11061 (format "H%d:%s" (1+ hierarchy)
11062 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
11063 pt)))))
11064 (if (listp regexp)
11065 (arrange
11066 (sort
11067 (loop for re in regexp
11068 for hierarchy from 0
11069 do (goto-char (point-min))
11070 appending
11071 (loop
11072 while (re-search-forward re nil t)
11073 collect (cons (matched) hierarchy)))
11074 (lambda (a b) (> (cdar b) (cdar a)))))
11075 (loop while (re-search-forward regexp nil t)
11076 collect (matched))))))))
11079 (defun anything-headline-make-candidate-buffer (regexp subexp)
11080 (with-current-buffer (anything-candidate-buffer 'local)
11081 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
11082 do (insert
11083 (format "%5d:%s\n"
11084 (with-anything-current-buffer
11085 (line-number-at-pos pos))
11086 content)))))
11088 (defun anything-headline-goto-position (pos recenter)
11089 (goto-char pos)
11090 (unless recenter
11091 (set-window-start (get-buffer-window anything-current-buffer) (point))))
11094 ;; Plug-in: persistent-help
11095 (defun anything-compile-source--persistent-help (source)
11096 (append source '((header-line . anything-persistent-help-string))))
11097 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
11099 (defun anything-persistent-help-string ()
11100 (substitute-command-keys
11101 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
11102 (or (anything-interpret-value (anything-attr 'persistent-help))
11103 (anything-aif (or (assoc-default 'persistent-action
11104 (anything-get-current-source))
11105 (assoc-default 'action
11106 (anything-get-current-source)))
11107 (cond ((symbolp it) (symbol-name it))
11108 ((listp it) (or (ignore-errors (caar it)) ""))))
11110 " (keeping session)")))
11112 (anything-document-attribute 'persistent-help "persistent-help plug-in"
11113 "A string to explain persistent-action of this source.
11114 It also accepts a function or a variable name.")
11116 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
11118 ;; Plug-in: Type customize
11119 (defun anything-c-uniq-list (lst)
11120 "Like `remove-duplicates' in CL.
11121 But cut deeper duplicates and test by `equal'. "
11122 (reverse (remove-duplicates (reverse lst) :test 'equal)))
11123 (defvar anything-additional-type-attributes nil)
11124 (defun anything-c-arrange-type-attribute (type spec)
11125 "Override type attributes by `define-anything-type-attribute'.
11127 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
11129 Example: Set `play-sound-file' as default action
11130 (anything-c-arrange-type-attribute 'file
11131 '((action (\"Play sound\" . play-sound-file)
11132 REST ;; Rest of actions (find-file, find-file-other-window, ...)
11135 (add-to-list 'anything-additional-type-attributes
11136 (cons type
11137 (loop with typeattr = (assoc-default type anything-type-attributes)
11138 for (attr . value) in spec
11139 if (listp value)
11140 collect (cons attr
11141 (anything-c-uniq-list
11142 (loop for v in value
11143 if (eq v 'REST)
11144 append (assoc-default attr typeattr)
11145 else
11146 collect v)))
11147 else
11148 collect (cons attr value)))))
11149 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
11151 (defun anything-compile-source--type-customize (source)
11152 (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
11153 (append it source)
11154 source))
11155 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
11157 ;; Plug-in: default-action
11158 (defun anything-compile-source--default-action (source)
11159 (anything-aif (assoc-default 'default-action source)
11160 (append `((action ,it ,@(remove it (assoc-default 'action source))))
11161 source)
11162 source))
11163 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
11164 (anything-document-attribute 'default-action "default-action plug-in"
11165 "Default action.")
11168 ;;; Toggle anything-match-plugin
11171 (defvar anything-mp-initial-highlight-delay nil)
11173 ;;;###autoload
11174 (defun anything-c-toggle-match-plugin ()
11175 "Toggle anything-match-plugin."
11176 (interactive)
11177 (let ((anything-match-plugin-enabled
11178 (member 'anything-compile-source--match-plugin
11179 anything-compile-source-functions)))
11180 (flet ((disable-match-plugin ()
11181 (setq anything-compile-source-functions
11182 (delq 'anything-compile-source--match-plugin
11183 anything-compile-source-functions))
11184 (setq anything-mp-initial-highlight-delay
11185 anything-mp-highlight-delay)
11186 (setq anything-mp-highlight-delay nil))
11187 (enable-match-plugin ()
11188 (require 'anything-match-plugin)
11189 (unless anything-mp-initial-highlight-delay
11190 (setq anything-mp-initial-highlight-delay
11191 anything-mp-highlight-delay))
11192 (setq anything-compile-source-functions
11193 (cons 'anything-compile-source--match-plugin
11194 anything-compile-source-functions))
11195 (unless anything-mp-highlight-delay
11196 (setq anything-mp-highlight-delay
11197 anything-mp-initial-highlight-delay))))
11198 (if anything-match-plugin-enabled
11199 (when (y-or-n-p "Really disable match-plugin? ")
11200 (disable-match-plugin)
11201 (message "Anything-match-plugin disabled"))
11202 (when (y-or-n-p "Really enable match-plugin? ")
11203 (enable-match-plugin)
11204 (message "Anything-match-plugin enabled"))))))
11208 ;;; Type Attributes
11211 (define-anything-type-attribute 'buffer
11212 `((action
11213 ("Switch to buffer" . anything-c-switch-to-buffer)
11214 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
11215 ("Switch to buffer other window" . switch-to-buffer-other-window)
11216 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
11217 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
11218 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
11219 ("View buffer" . view-buffer)
11220 ("Display buffer" . display-buffer)
11221 ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
11222 ("Revert buffer(s)" . anything-revert-marked-buffers)
11223 ("Insert buffer" . insert-buffer)
11224 ("Kill buffer(s)" . anything-kill-marked-buffers)
11225 ("Diff with file" . diff-buffer-with-file)
11226 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
11227 ("Ediff Merge marked buffers" . (lambda (candidate)
11228 (anything-ediff-marked-buffers candidate t))))
11229 (persistent-help . "Show this buffer")
11230 (candidate-transformer anything-c-skip-current-buffer
11231 anything-c-skip-boring-buffers
11232 anything-c-transform-buffer-display-string))
11233 "Buffer or buffer name.")
11235 (define-anything-type-attribute 'file
11236 `((action
11237 ("Find file" . anything-find-many-files)
11238 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
11239 ("Find file as root" . anything-find-file-as-root)
11240 ("Find file other window" . find-file-other-window)
11241 ("Find file other frame" . find-file-other-frame)
11242 ("Open dired in file's directory" . anything-c-open-dired)
11243 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
11244 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
11245 ("Checksum File" . anything-ff-checksum)
11246 ("View file" . view-file)
11247 ("Insert file" . insert-file)
11248 ("Delete file(s)" . anything-delete-marked-files)
11249 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
11250 ("Open file with default tool" . anything-c-open-file-with-default-tool)
11251 ("Find file in hex dump" . hexl-find-file))
11252 (persistent-help . "Show this file")
11253 (action-transformer anything-c-transform-file-load-el
11254 anything-c-transform-file-browse-url)
11255 (candidate-transformer anything-c-w32-pathname-transformer
11256 anything-c-skip-current-file
11257 anything-c-skip-boring-files
11258 anything-c-shorten-home-path))
11259 "File name.")
11261 (let ((actions '(("Describe command" . describe-function)
11262 ("Add command to kill ring" . anything-c-kill-new)
11263 ("Go to command's definition" . find-function)
11264 ("Debug on entry" . debug-on-entry)
11265 ("Cancel debug on entry" . cancel-debug-on-entry)
11266 ("Trace function" . trace-function)
11267 ("Trace function (background)" . trace-function-background)
11268 ("Untrace function" . untrace-function))))
11269 (define-anything-type-attribute 'command
11270 `((action ("Call interactively" . anything-c-call-interactively)
11271 ,@actions)
11272 ;; Sort commands according to their usage count.
11273 ;(filtered-candidate-transformer . anything-c-adaptive-sort)
11274 (coerce . anything-c-symbolify)
11275 (persistent-action . describe-function))
11276 "Command. (string or symbol)")
11278 (define-anything-type-attribute 'function
11279 `((action . ,actions)
11280 (action-transformer anything-c-transform-function-call-interactively)
11281 (candidate-transformer anything-c-mark-interactive-functions)
11282 (coerce . anything-c-symbolify))
11283 "Function. (string or symbol)"))
11285 (define-anything-type-attribute 'variable
11286 '((action ("Describe variable" . describe-variable)
11287 ("Add variable to kill ring" . anything-c-kill-new)
11288 ("Go to variable's definition" . find-variable)
11289 ("Set variable" . anything-c-set-variable))
11290 (coerce . anything-c-symbolify))
11291 "Variable.")
11293 (define-anything-type-attribute 'sexp
11294 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
11295 ("Add s-expression to kill ring" . kill-new))
11296 (action-transformer anything-c-transform-sexp-eval-command-sexp))
11297 "String representing S-Expressions.")
11299 (define-anything-type-attribute 'bookmark
11300 `((coerce . anything-bookmark-get-bookmark-from-name)
11301 (action
11302 ("Jump to bookmark" . (lambda (bookmark)
11303 (let ((current-prefix-arg anything-current-prefix-arg))
11304 (bookmark-jump bookmark))
11305 (anything-update)))
11306 ("Jump to BM other window" . (lambda (bookmark)
11307 (bookmark-jump-other-window bookmark)
11308 (anything-update)))
11309 ("Bookmark edit annotation" . bookmark-edit-annotation)
11310 ("Bookmark show annotation" . bookmark-show-annotation)
11311 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11312 ,@(and (locate-library "bookmark-extensions")
11313 `(("Edit Bookmark" . bmkext-edit-bookmark)))
11314 ("Rename bookmark" . bookmark-rename)
11315 ("Relocate bookmark" . bookmark-relocate)))
11316 "Bookmark name.")
11318 (define-anything-type-attribute 'line
11319 '((display-to-real . anything-c-display-to-real-line)
11320 (action ("Go to Line" . anything-c-action-line-goto)))
11321 "LINENO:CONTENT string, eg. \" 16:foo\".
11323 Optional `target-file' attribute is a name of target file.
11325 Optional `before-jump-hook' attribute is a function with no
11326 arguments which is called before jumping to position.
11328 Optional `after-jump-hook' attribute is a function with no
11329 arguments which is called after jumping to position.
11331 If `adjust' attribute is specified, searches the line whose
11332 content is CONTENT near the LINENO.
11334 If `recenter' attribute is specified, the line is displayed at
11335 the center of window, otherwise at the top of window.
11338 (define-anything-type-attribute 'file-line
11339 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11340 (multiline)
11341 (action ("Go to" . anything-c-action-file-line-goto)))
11342 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11344 Optional `default-directory' attribute is a default-directory
11345 FILENAME is interpreted.
11347 Optional `before-jump-hook' attribute is a function with no
11348 arguments which is called before jumping to position.
11350 Optional `after-jump-hook' attribute is a function with no
11351 arguments which is called after jumping to position.
11353 If `adjust' attribute is specified, searches the line whose
11354 content is CONTENT near the LINENO.
11356 If `recenter' attribute is specified, the line is displayed at
11357 the center of window, otherwise at the top of window.
11360 (define-anything-type-attribute 'timer
11361 '((real-to-display . anything-c-timer-real-to-display)
11362 (action ("Cancel Timer" . cancel-timer)
11363 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11364 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11365 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11366 (persistent-help . "Describe Function"))
11367 "Timer.")
11369 ;;;; Default `anything-sources'
11370 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11371 ;; tend to invoke M-x anything directly. So I offer default setting.
11372 (setq anything-sources
11373 '(anything-c-source-buffers-list
11374 anything-c-source-recentf
11375 anything-c-source-files-in-current-dir+))
11377 ;;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
11379 (provide 'anything-config)
11381 ;;; Local Variables:
11382 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
11383 ;;; End:
11385 ;; How to save (DO NOT REMOVE!!)
11386 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
11387 ;;; anything-config.el ends here
11389 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
11390 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
11391 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
11392 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
11393 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
11394 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
11395 ;;; LocalWords: dotimes Thierry online vname
11396 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
11397 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
11398 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
11399 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
11400 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
11401 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
11402 ;;; LocalWords: startpos noselect dont desc