* anything.el (anything-resume): Fix docstring.
[anything-config.git] / anything-config.el
blob3b5b26220a2dcdae248715e1092671dd0399d61c
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-buffer+'.
172 ;; `anything-buffer-run-grep'
173 ;; Run Grep action from `anything-c-source-buffer+'.
174 ;; `anything-buffer-run-zgrep'
175 ;; Run Grep action from `anything-c-source-buffer+'.
176 ;; `anything-buffer-run-query-replace-regexp'
177 ;; Run Query replace regexp action from `anything-c-source-buffer+'.
178 ;; `anything-buffer-run-query-replace'
179 ;; Run Query replace action from `anything-c-source-buffer+'.
180 ;; `anything-buffer-switch-other-window'
181 ;; Run switch to other window action from `anything-c-source-buffer+'.
182 ;; `anything-buffer-switch-other-frame'
183 ;; Run switch to other frame action from `anything-c-source-buffer+'.
184 ;; `anything-buffer-switch-to-elscreen'
185 ;; Run switch to elscreen action from `anything-c-source-buffer+'.
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:
661 ;;; Require
664 (require 'anything)
665 (require 'thingatpt)
666 (require 'ffap)
667 (require 'cl)
668 (require 'dired-aux)
669 (require 'dired-x)
670 (require 'tramp)
671 (require 'grep)
672 (require 'url)
673 (require 'xml)
674 (eval-when-compile (require 'org)) ; Shut up byte compiler about org-directory.
675 (eval-when-compile (require 'semantic nil t))
676 (require 'anything-match-plugin)
678 ;;; Declare external functions
681 (declare-function gnus-dired-attach "ext:gnus-dired.el" (files-to-attach))
682 (declare-function image-dired-display-image "image-dired.el" (file &optional original-size))
683 (declare-function image-dired-update-property "image-dired.el" (prop value))
684 (declare-function woman-file-name-all-completions "woman.el" (topic))
685 (declare-function Man-getpage-in-background "man.el" (topic))
686 (declare-function simple-call-tree-analyze "ext:simple-call-tree.el" (&optional test))
687 (declare-function yaoddmuse-update-pagename "ext:yaoddmuse.el" (&optional unforced))
688 (declare-function yaoddmuse-get-library-list "ext:yaoddmuse.el" (&optional dirs string))
689 (declare-function org-get-current-options "ext:org-exp.el")
690 (declare-function emms-streams "ext:emms-streams")
691 (declare-function emms-stream-delete-bookmark "ext:emms-streams")
692 (declare-function emms-stream-add-bookmark "ext:emms-streams" (name url fd type))
693 (declare-function emms-stream-save-bookmarks-file "ext:emms-streams")
694 (declare-function emms-stream-quit "ext:emms-streams")
695 (declare-function with-current-emms-playlist "ext:emms" (&rest body))
696 (declare-function emms-playlist-tracks-in-region "ext:emms" (beg end))
697 (declare-function emms-playlist-first "ext:emms")
698 (declare-function emms-playlist-mode-play-smart "ext:emms-playlist-mode")
699 (declare-function term-line-mode "term")
700 (declare-function term-char-mode "term")
701 (declare-function term-send-input "term")
702 (declare-function term-send-eof "term")
703 (declare-function Info-index-nodes "info" (&optional file))
704 (declare-function Info-goto-node "info" (&optional fork))
705 (declare-function elscreen-find-screen-by-buffer "ext:elscreen.el" (buffer &optional create))
706 (declare-function elscreen-find-file "ext:elscreen.el" (filename))
707 (declare-function elscreen-goto "ext:elscreen.el" (screen))
708 (declare-function semantic-format-tag-summarize "ext:format.el" (tag &optional parent color) t)
709 (declare-function semantic-tag-components "ext:tag.el" (tag) t)
710 (declare-function semantic-go-to-tag "ext:tag-file.el" (tag) t)
711 (declare-function semantic-tag-type "ext:tag-file.el" (tag) t)
712 (declare-function semantic-tag-class "ext:tag-file.el" (tag) t)
713 (declare-function bbdb "ext:bbdb-com")
714 (declare-function bbdb-current-record "ext:bbdb-com")
715 (declare-function bbdb-redisplay-one-record "ext:bbdb-com")
716 (declare-function bbdb-record-net "ext:bbdb-com" (string) t)
717 (declare-function bbdb-current-record "ext:bbdb-com")
718 (declare-function bbdb-dwim-net-address "ext:bbdb-com")
719 (declare-function bbdb-records "ext:bbdb-com"
720 (&optional dont-check-disk already-in-db-buffer))
721 (declare-function eshell-read-aliases-list "em-alias")
722 (declare-function eshell-send-input "esh-mode" (&optional use-region queue-p no-newline))
723 (declare-function eldoc-current-symbol "eldoc")
724 (declare-function eldoc-get-fnsym-args-string "eldoc" (sym &optional index))
725 (declare-function eldoc-get-var-docstring "eldoc" (sym))
726 (declare-function eldoc-fnsym-in-current-sexp "eldoc")
727 (declare-function find-library-name "find-func.el" (library))
728 (declare-function adoc-construct "ext:auto-document.el" (buf))
729 (declare-function adoc-first-line "ext:auto-document.el" (str))
730 (declare-function adoc-prin1-to-string "ext:auto-document.el" (object))
732 ;;; compatibility
735 (unless (fboundp 'window-system)
736 (defun window-system (&optional arg)
737 window-system))
739 ;;; Customize
742 (defgroup anything-config nil
743 "Predefined configurations for `anything.el'."
744 :group 'anything)
746 (defcustom anything-c-adaptive-history-file
747 "~/.emacs.d/anything-c-adaptive-history"
748 "Path of file where history information is stored."
749 :type 'string
750 :group 'anything-config)
752 (defcustom anything-c-adaptive-history-length 50
753 "Maximum number of candidates stored for a source."
754 :type 'number
755 :group 'anything-config)
757 (defcustom anything-c-google-suggest-url
758 "http://google.com/complete/search?output=toolbar&q="
759 "URL used for looking up Google suggestions."
760 :type 'string
761 :group 'anything-config)
763 (defcustom anything-c-google-suggest-search-url
764 "http://www.google.com/search?ie=utf-8&oe=utf-8&q="
765 "URL used for Google searching."
766 :type 'string
767 :group 'anything-config)
769 (defcustom anything-google-suggest-use-curl-p nil
770 "*When non--nil use CURL to get info from `anything-c-google-suggest-url'.
771 Otherwise `url-retrieve-synchronously' is used."
772 :type 'boolean
773 :group 'anything-config)
775 (defcustom anything-c-yahoo-suggest-url
776 "http://search.yahooapis.com/WebSearchService/V1/relatedSuggestion?appid=Generic&query="
777 "Url used for looking up Yahoo suggestions."
778 :type 'string
779 :group 'anything-config)
781 (defcustom anything-c-yahoo-suggest-search-url
782 "http://search.yahoo.com/search?&ei=UTF-8&fr&h=c&p="
783 "Url used for Yahoo searching."
784 :type 'string
785 :group 'anything-config)
787 (defcustom anything-c-boring-buffer-regexp
788 (rx (or
789 (group bos " ")
790 ;; anything-buffer
791 "*anything"
792 ;; echo area
793 " *Echo Area" " *Minibuf"))
794 "The regexp that match boring buffers.
795 Buffer candidates matching this regular expression will be
796 filtered from the list of candidates if the
797 `anything-c-skip-boring-buffers' candidate transformer is used, or
798 they will be displayed with face `file-name-shadow' if
799 `anything-c-shadow-boring-buffers' is used."
800 :type 'string
801 :group 'anything-config)
802 ;; (string-match anything-c-boring-buffer-regexp "buf")
803 ;; (string-match anything-c-boring-buffer-regexp " hidden")
804 ;; (string-match anything-c-boring-buffer-regexp " *Minibuf-1*")
806 (defcustom anything-c-boring-file-regexp
807 (rx (or
808 ;; Boring directories
809 (and "/" (or ".svn" "CVS" "_darcs" ".git" ".hg") (or "/" eol))
810 ;; Boring files
811 (and line-start ".#")
812 (and (or ".class" ".la" ".o" "~") eol)))
813 "The regexp that match boring files.
814 File candidates matching this regular expression will be
815 filtered from the list of candidates if the
816 `anything-c-skip-boring-files' candidate transformer is used, or
817 they will be displayed with face `file-name-shadow' if
818 `anything-c-shadow-boring-files' is used."
819 :type 'string
820 :group 'anything-config)
822 (defcustom anything-kill-ring-threshold 10
823 "*Minimum length to be listed by `anything-c-source-kill-ring'."
824 :type 'integer
825 :group 'anything-config)
827 (defcustom anything-su-or-sudo "su"
828 "What command to use for root access."
829 :type 'string
830 :group 'anything-config)
832 (defcustom anything-for-files-prefered-list
833 '(anything-c-source-ffap-line
834 anything-c-source-ffap-guesser
835 anything-c-source-buffers-list
836 anything-c-source-recentf
837 anything-c-source-bookmarks
838 anything-c-source-file-cache
839 anything-c-source-files-in-current-dir+
840 anything-c-source-locate)
841 "Your prefered sources to find files."
842 :type 'list
843 :group 'anything-config)
845 (defcustom anything-create--actions-private nil
846 "User defined actions for `anything-create' / `anything-c-source-create'.
847 It is a list of (DISPLAY . FUNCTION) pairs like `action'
848 attribute of `anything-sources'.
850 It is prepended to predefined pairs."
851 :type 'list
852 :group 'anything-config)
854 (defcustom anything-allow-skipping-current-buffer t
855 "Show current buffer or not in anything buffer"
856 :type 'boolean
857 :group 'anything-config)
859 (defcustom anything-c-enable-eval-defun-hack t
860 "*If non-nil, execute `anything' using the source at point when C-M-x is pressed.
861 This hack is invoked when pressing C-M-x in the form \
862 (defvar anything-c-source-XXX ...) or (setq anything-c-source-XXX ...)."
863 :type 'boolean
864 :group 'anything-config)
866 (defcustom anything-tramp-verbose 0
867 "*Just like `tramp-verbose' but specific to anything.
868 When set to 0 don't show tramp messages in anything.
869 If you want to have the default tramp messages set it to 3."
870 :type 'integer
871 :group 'anything-config)
873 (defcustom anything-raise-command nil
874 "*A shell command to jump to a window running specific program.
875 Need external program wmctrl.
876 This will be use with `format', so use something like \"wmctrl -xa %s\"."
877 :type 'string
878 :group 'anything-config)
880 (defun anything-set-anything-command-map-prefix-key (var key)
881 (declare (special anything-command-map-prefix-key))
882 (when (boundp 'anything-command-map-prefix-key)
883 (global-unset-key (read-kbd-macro anything-command-map-prefix-key)))
884 (setq anything-command-map-prefix-key key)
885 (global-set-key (read-kbd-macro anything-command-map-prefix-key)
886 'anything-command-map))
888 (defcustom anything-command-map-prefix-key "<f5> a"
889 "*The prefix key for all `anything-command-map' commands.
891 !!WARNING!!
892 This default value is very likely to be changed,
893 because it is under discussion."
894 :type 'string
895 :set 'anything-set-anything-command-map-prefix-key
896 :group 'anything-config)
898 (defcustom anything-c-find-files-show-icons nil
899 "*Whether show or hide icons in `anything-find-files'."
900 :type 'boolean
901 :group 'anything-config)
903 (defcustom anything-c-find-files-icons-directory
904 (and (window-system)
905 (dolist (i image-load-path)
906 (if (file-directory-p (expand-file-name "tree-widget/default" (eval i)))
907 (return (expand-file-name "tree-widget/default" (eval i))))))
908 "*Default path where to find files and directory icons."
909 :type 'string
910 :group 'anything-config)
912 (defcustom anything-c-browse-code-regexp-lisp
913 "^ *\(def\\(un\\|subst\\|macro\\|face\\|alias\\|advice\\|struct\\|\
914 type\\|theme\\|var\\|group\\|custom\\|const\\|method\\|class\\)"
915 "*Regexp used to parse lisp buffer when browsing code."
916 :type 'string
917 :group 'anything-config)
919 (defcustom anything-c-browse-code-regexp-python
920 "\\<def\\>\\|\\<class\\>"
921 "*Regexp used to parse python buffer when browsing code."
922 :type 'string
923 :group 'anything-config)
925 (defcustom anything-c-browse-code-regexp-alist
926 `((lisp-interaction-mode . ,anything-c-browse-code-regexp-lisp)
927 (emacs-lisp-mode . ,anything-c-browse-code-regexp-lisp)
928 (lisp-mode . ,anything-c-browse-code-regexp-lisp)
929 (python-mode . ,anything-c-browse-code-regexp-python))
930 "*Alist to store regexps for browsing code corresponding \
931 to a specific `major-mode'."
932 :type 'list
933 :group 'anything-config)
935 (defcustom anything-c-external-programs-associations nil
936 "*Alist to store externals programs associated with file extension.
937 This variable overhide setting in .mailcap file.
938 e.g : '\(\(\"jpg\" . \"gqview\"\) (\"pdf\" . \"xpdf\"\)\) "
939 :type 'list
940 :group 'anything-config)
942 (defcustom anything-ff-auto-update-initial-value t
943 "Auto update when only one candidate directory is matched.
944 This is the default value when starting `anything-find-files'."
945 :group 'anything-config
946 :type 'boolean)
948 (defcustom anything-c-copy-async-prefered-emacs "emacs"
949 "Path to the emacs you want to use for copying async.
950 Emacs versions < 24 fail to copy directory due to a bug not fixed
951 in `copy-directory'."
952 :group 'anything-config
953 :type 'string)
955 (defcustom anything-ff-lynx-style-map t
956 "Use arrow keys to navigate with `anything-find-files'."
957 :group 'anything-config
958 :type 'boolean)
960 (defcustom anything-ff-history-max-length 100
961 "*Number of elements shown in `anything-find-files' history."
962 :group 'anything-config
963 :type 'integer)
965 (defcustom anything-ff-smart-completion t
966 "Try to complete filenames smarter when non--nil.
967 See `anything-ff-transform-fname-for-completion' for more info."
968 :group 'anything-config
969 :type 'boolean)
971 (defcustom anything-ff-default-kbsize 1024.0
972 "Default Kbsize to use for showing files size.
973 It is a float, usually 1024.0 but could be 1000.0 on some systems."
974 :group 'anything-config
975 :type 'float)
977 (defcustom anything-ff-tramp-not-fancy t
978 "No colors when listing remote files when set to non--nil.
979 This make listing much faster, specially on slow machines."
980 :group 'anything-config
981 :type 'boolean)
983 (defcustom anything-ff-exif-data-program "exiftran"
984 "*Program used to extract exif data of an image file."
985 :group 'anything-config
986 :type 'string)
988 (defcustom anything-ff-exif-data-program-args "-d"
989 "*Arguments used for `anything-ff-exif-data-program'."
990 :group 'anything-config
991 :type 'string)
993 (defcustom anything-c-grep-use-ioccur-style-keys t
994 "Use Arrow keys to jump to occurences."
995 :group 'anything-config
996 :type 'boolean)
998 (defcustom anything-c-pdfgrep-default-read-command "xpdf '%f' %p"
999 "Default command to read pdf files from pdfgrep.
1000 Where '%f' format spec is filename and '%p' is page number"
1001 :group 'anything-config
1002 :type 'string)
1004 (defcustom anything-c-etags-tag-file-name "TAGS"
1005 "Etags tag file name."
1006 :type 'string
1007 :group 'anything-config)
1009 (defcustom anything-c-etags-tag-file-search-limit 10
1010 "The limit level of directory to search tag file.
1011 Don't search tag file deeply if outside this value."
1012 :type 'number
1013 :group 'anything-config)
1015 (defcustom anything-c-filelist-file-name nil
1016 "Filename of file list.
1017 Accept a list of string for multiple files.
1019 This file tend to be very large \(> 100MB\) and recommend to be in ramdisk for speed.
1020 File list is created by make-filelist.rb script.
1022 Usage:
1023 ruby make-filelist.rb > /tmp/all.filelist
1025 Then
1026 ;; Assume that /tmp is ramdisk or tmpfs
1027 \(setq anything-grep-candidates-fast-directory-regexp \"^/tmp/\"\)
1028 \(setq anything-c-filelist-file-name \"/tmp/all.filelist\"\)
1030 :type 'string
1031 :group 'anything-config)
1033 (defcustom anything-c-eldoc-in-minibuffer-show-fn
1034 'anything-c-eldoc-show-in-mode-line
1035 "A function to display eldoc info.
1036 Should take one arg: the string to display."
1037 :group 'anything-config
1038 :type 'symbol)
1040 (defcustom anything-c-turn-on-show-completion t
1041 "Display candidate in buffer while moving selection when non--nil."
1042 :group 'anything-config
1043 :type 'boolean)
1045 (defcustom anything-lisp-completion-or-indent-delay 0.6
1046 "After this delay `anything-lisp-completion-counter' is reset to 0.
1047 This allow to indent again without completing lisp symbol after this delay.
1048 Default is 0.6 seconds."
1049 :group 'anything-config
1050 :type 'number)
1052 (defcustom anything-c-default-external-file-browser "nautilus"
1053 "Default external file browser for your system.
1054 Directories will be opened externally with it.
1055 Set to nil if you do not have external file browser
1056 or do not want to use it."
1057 :group 'anything-config
1058 :type 'string)
1060 (defcustom anything-c-use-adaptative-sorting nil
1061 "*Wheter to use or not adaptative sorting.
1062 Even if a source use it, it will have no effect when set to nil."
1063 :type 'boolean
1064 :group 'anything-config)
1066 (defcustom anything-ff-newfile-prompt-p t
1067 "Whether Prompt or not when creating new file.
1068 This set `ffap-newfile-prompt'."
1069 :type 'boolean
1070 :group 'anything-config)
1073 (defcustom anything-ff-avfs-directory nil
1074 "*The default avfs directory, usually '.avfs'.
1075 When this is set you will be able to expand archive filenames with `C-z'
1076 inside an avfs directory mounted with mountavfs.
1077 See <http://sourceforge.net/projects/avf/>."
1078 :type 'boolean
1079 :group 'anything-config)
1081 (defcustom anything-ff-file-compressed-list '("gz" "bz2" "zip" "7z")
1082 "*Minimal list of compressed files extension."
1083 :type 'list
1084 :group 'anything-config)
1086 (defcustom anything-locate-db-file-regexp "m?locate\.db$"
1087 "Default regexp to match locate database.
1088 If nil Search in all files."
1089 :type 'string
1090 :group 'anything-config)
1092 (defcustom anything-c-eldoc-show-in-mode-line-delay 12
1093 "Eldoc will show info in mode-line during this delay if user is idle."
1094 :type 'integer
1095 :group 'anything-config)
1097 (defcustom anything-c-copy-files-async-log-file "/tmp/dired.log"
1098 "The file used to communicate with two emacs when copying files async."
1099 :type 'string
1100 :group 'anything-config)
1102 ;;; General internal variables
1105 (defvar anything-c-external-commands-list nil
1106 "A list of all external commands the user can execute. If this
1107 variable is not set by the user, it will be calculated
1108 automatically.")
1110 ;;; Faces
1113 (defface anything-buffer-saved-out
1114 '((t (:foreground "red")))
1115 "*Face used for buffer files modified outside of emacs."
1116 :group 'anything-config)
1118 (defface anything-buffer-not-saved
1119 '((t (:foreground "Indianred2")))
1120 "*Face used for buffer files not already saved on disk."
1121 :group 'anything-config)
1123 (defface anything-ff-prefix
1124 '((t (:background "yellow" :foreground "black")))
1125 "*Face used to prefix new file or url paths in `anything-find-files'."
1126 :group 'anything-config)
1128 (defface anything-ff-executable
1129 '((t (:foreground "green")))
1130 "*Face used for executable files in `anything-find-files'."
1131 :group 'anything-config)
1133 (defface anything-ff-directory
1134 '((t (:foreground "DarkRed" :background "LightGray")))
1135 "*Face used for directories in `anything-find-files'."
1136 :group 'anything-config)
1138 (defface anything-ff-symlink
1139 '((t (:foreground "DarkOrange")))
1140 "*Face used for symlinks in `anything-find-files'."
1141 :group 'anything-config)
1143 (defface anything-ff-invalid-symlink
1144 '((t (:foreground "black" :background "red")))
1145 "*Face used for invalid symlinks in `anything-find-files'."
1146 :group 'anything-config)
1148 (defface anything-ff-file
1149 '((t (:foreground "CadetBlue" :underline t)))
1150 "*Face used for file names in `anything-find-files'."
1151 :group 'anything-config)
1153 (defface anything-grep-match
1154 '((t (:inherit match)))
1155 "Face used to highlight grep matches."
1156 :group 'anything-config)
1158 (defface anything-grep-file
1159 '((t (:foreground "BlueViolet" :underline t)))
1160 "Face used to highlight grep results filenames."
1161 :group 'anything-config)
1163 (defface anything-grep-lineno
1164 '((t (:foreground "Darkorange1")))
1165 "Face used to highlight grep number lines."
1166 :group 'anything-config)
1168 (defface anything-grep-running
1169 '((t (:foreground "Red")))
1170 "Face used in mode line when grep is running."
1171 :group 'anything-config)
1173 (defface anything-grep-finish
1174 '((t (:foreground "Green")))
1175 "Face used in mode line when grep is finish."
1176 :group 'anything-config)
1178 (defface anything-M-x-key-face '((t (:foreground "orange" :underline t)))
1179 "*Face used in anything-M-x to show keybinding."
1180 :group 'anything)
1182 (defface anything-bmkext-info
1183 '((t (:foreground "green")))
1184 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1185 :group 'anything)
1187 (defface anything-bmkext-w3m
1188 '((t (:foreground "yellow")))
1189 "*Face used for W3m Emacs bookmarks (not w3m bookmarks)."
1190 :group 'anything)
1192 (defface anything-bmkext-gnus
1193 '((t (:foreground "magenta")))
1194 "*Face used for Gnus bookmarks."
1195 :group 'anything)
1197 (defface anything-bmkext-man
1198 '((t (:foreground "Orange4")))
1199 "*Face used for Woman/man bookmarks."
1200 :group 'anything)
1202 (defface anything-bmkext-no--file
1203 '((t (:foreground "grey")))
1204 "*Face used for non--file bookmarks."
1205 :group 'anything)
1207 (defface anything-bmkext-file
1208 '((t (:foreground "Deepskyblue2")))
1209 "*Face used for non--file bookmarks."
1210 :group 'anything)
1212 (defface anything-bookmarks-su-face '((t (:foreground "red")))
1213 "Face for su/sudo bookmarks."
1214 :group 'anything)
1216 (defface anything-w3m-bookmarks-face '((t (:foreground "cyan1" :underline t)))
1217 "Face for w3m bookmarks" :group 'anything)
1219 (defface anything-emms-playlist
1220 '((t (:foreground "Springgreen4" :underline t)))
1221 "*Face used for tracks in current emms playlist."
1222 :group 'anything)
1224 (defface anything-apt-installed
1225 '((t (:foreground "green")))
1226 "*Face used for apt installed candidates."
1227 :group 'anything)
1229 (defface anything-gentoo-match-face '((t (:foreground "red")))
1230 "Face for anything-gentoo installed packages."
1231 :group 'traverse-faces)
1233 (defface anything-lisp-show-completion
1234 '((t (:background "DarkSlateGray")))
1235 "*Face used for showing candidates in `anything-lisp-completion'."
1236 :group 'anything-config)
1238 (defface anything-lisp-completion-info
1239 '((t (:foreground "red")))
1240 "*Face used for showing info in `anything-lisp-completion'."
1241 :group 'anything-config)
1243 (defface anything-overlay-line-face '((t (:background "IndianRed4" :underline t)))
1244 "Face for source header in the anything buffer." :group 'anything)
1246 ;;;###autoload
1247 (defun anything-configuration ()
1248 "Customize `anything'."
1249 (interactive)
1250 (customize-group "anything-config"))
1252 ;;; Anything-command-map
1255 ;;;###autoload
1256 (defvar anything-command-map)
1257 (define-prefix-command 'anything-command-map)
1260 (define-key anything-command-map (kbd "<SPC>") 'anything-execute-anything-command)
1261 (define-key anything-command-map (kbd "e") 'anything-c-etags-select)
1262 (define-key anything-command-map (kbd "l") 'anything-locate)
1263 (define-key anything-command-map (kbd "s") 'anything-surfraw)
1264 (define-key anything-command-map (kbd "r") 'anything-regexp)
1265 (define-key anything-command-map (kbd "w") 'anything-w3m-bookmarks)
1266 (define-key anything-command-map (kbd "x") 'anything-firefox-bookmarks)
1267 (define-key anything-command-map (kbd "#") 'anything-emms)
1268 (define-key anything-command-map (kbd "m") 'anything-man-woman)
1269 (define-key anything-command-map (kbd "t") 'anything-top)
1270 (define-key anything-command-map (kbd "i") 'anything-imenu)
1271 (define-key anything-command-map (kbd "<tab>") 'anything-lisp-completion-at-point)
1272 (define-key anything-command-map (kbd "p") 'anything-list-emacs-process)
1273 (define-key anything-command-map (kbd "C-x r b") 'anything-c-pp-bookmarks)
1274 (define-key anything-command-map (kbd "M-y") 'anything-show-kill-ring)
1275 (define-key anything-command-map (kbd "C-c <SPC>") 'anything-all-mark-rings)
1276 (define-key anything-command-map (kbd "C-x C-f") 'anything-find-files)
1277 (define-key anything-command-map (kbd "f") 'anything-for-files)
1278 (define-key anything-command-map (kbd "C-:") 'anything-eval-expression-with-eldoc)
1279 (define-key anything-command-map (kbd "C-,") 'anything-calcul-expression)
1280 (define-key anything-command-map (kbd "M-x") 'anything-M-x)
1281 (define-key anything-command-map (kbd "C-x C-w") 'anything-write-file)
1282 (define-key anything-command-map (kbd "C-x i") 'anything-insert-file)
1283 (define-key anything-command-map (kbd "M-s o") 'anything-occur)
1284 (define-key anything-command-map (kbd "M-g s") 'anything-do-grep)
1285 (define-key anything-command-map (kbd "c") 'anything-colors)
1286 (define-key anything-command-map (kbd "F") 'anything-select-xfont)
1287 (define-key anything-command-map (kbd "C-c f") 'anything-recentf)
1288 (define-key anything-command-map (kbd "C-c g") 'anything-google-suggest)
1289 (define-key anything-command-map (kbd "h i") 'anything-info-at-point)
1290 (define-key anything-command-map (kbd "h r") 'anything-info-emacs)
1291 (define-key anything-command-map (kbd "h g") 'anything-info-gnus)
1292 (define-key anything-command-map (kbd "C-x C-b") 'anything-buffers-list)
1293 (define-key anything-command-map (kbd "C-c C-b") 'anything-browse-code)
1294 (define-key anything-command-map (kbd "C-x r i") 'anything-register)
1295 (define-key anything-command-map (kbd "C-c C-x") 'anything-c-run-external-command)
1297 ;; In Emacs 23.1.50, minibuffer-local-must-match-filename-map was renamed to
1298 ;; minibuffer-local-filename-must-match-map.
1299 (defvar minibuffer-local-filename-must-match-map (make-sparse-keymap)) ;; Emacs 23.1.+
1300 (defvar minibuffer-local-must-match-filename-map (make-sparse-keymap)) ;; Older Emacsen
1301 (dolist (map (list minibuffer-local-filename-completion-map
1302 minibuffer-local-completion-map
1303 minibuffer-local-must-match-filename-map
1304 minibuffer-local-filename-must-match-map
1305 minibuffer-local-map
1306 minibuffer-local-isearch-map
1307 minibuffer-local-must-match-map
1308 minibuffer-local-ns-map))
1309 (define-key map "\C-r" 'anything-minibuffer-history))
1311 ;;; Menu
1314 (easy-menu-define nil global-map
1315 "`anything' menu"
1316 '("Anything"
1317 ["All anything commands" anything-execute-anything-command t]
1318 ["Find any Files/Buffers" anything-for-files t]
1319 "----"
1320 ("Files:"
1321 ["Find files" anything-find-files t]
1322 ["Recent Files" anything-recentf t]
1323 ["Locate" anything-locate t]
1324 ["Bookmarks" anything-c-pp-bookmarks t])
1325 ("Buffers:"
1326 ["Find buffers" anything-buffers-list t])
1327 ("Commands:"
1328 ["Emacs Commands" anything-M-x t]
1329 ["Externals Commands" anything-c-run-external-command t])
1330 ("Info:"
1331 ["Info at point" anything-info-at-point t]
1332 ["Emacs Manual index" anything-info-emacs t]
1333 ["Gnus Manual index" anything-info-gnus t])
1334 ("Org:"
1335 ["Org keywords" anything-org-keywords t]
1336 ["Org headlines" anything-org-headlines t])
1337 ("Tools:"
1338 ["Occur" anything-occur t]
1339 ["Grep" anything-do-grep t]
1340 ["Etags" anything-c-etags-select t]
1341 ["Lisp complete at point" anything-lisp-completion-at-point t]
1342 ["Browse Kill ring" anything-show-kill-ring t]
1343 ["Browse register" anything-register t]
1344 ["Browse code" anything-browse-code t]
1345 ["Mark Ring" anything-all-mark-rings t]
1346 ["Regexp handler" anything-regexp t]
1347 ["Colors & Faces" anything-colors t]
1348 ["Show xfonts" anything-select-xfont t]
1349 ["Imenu" anything-imenu t]
1350 ["Google Suggest" anything-google-suggest t]
1351 ["Eval expression" anything-eval-expression-with-eldoc t]
1352 ["Calcul expression" anything-calcul-expression t]
1353 ["Man pages" anything-man-woman t]
1354 ["Top externals process" anything-top t]
1355 ["Emacs internals process" anything-list-emacs-process t])
1356 "----"
1357 ["Prefered Options" anything-configuration t]))
1360 ;;; Specialized keymaps
1363 (defvar anything-c-buffer-map
1364 (let ((map (copy-keymap anything-map)))
1365 (define-key map (kbd "C-c ?") 'anything-c-buffer-help)
1366 ;; No need to have separate command for grep and zgrep
1367 ;; as we don't use recursivity for buffers.
1368 ;; So use zgrep for both as it is capable to handle non--compressed files.
1369 (define-key map (kbd "M-g s") 'anything-buffer-run-zgrep)
1370 (define-key map (kbd "M-g z") 'anything-buffer-run-zgrep)
1371 (define-key map (kbd "C-o") 'anything-buffer-switch-other-window)
1372 (define-key map (kbd "C-c C-o") 'anything-buffer-switch-other-frame)
1373 (define-key map (kbd "C-=") 'anything-buffer-diff-persistent)
1374 (define-key map (kbd "M-U") 'anything-buffer-revert-persistent)
1375 (define-key map (kbd "M-D") 'anything-buffer-run-kill-buffers)
1376 (define-key map (kbd "C-x C-s") 'anything-buffer-save-persistent)
1377 (define-key map (kbd "C-M-%") 'anything-buffer-run-query-replace-regexp)
1378 (define-key map (kbd "M-%") 'anything-buffer-run-query-replace)
1379 (when (locate-library "elscreen")
1380 (define-key map (kbd "<C-tab>") 'anything-buffer-switch-to-elscreen))
1381 (delq nil map))
1382 "Keymap for buffer sources in anything.")
1384 (defvar anything-find-files-map
1385 (let ((map (copy-keymap anything-map)))
1386 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1387 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1388 (define-key map (kbd "M-g z") 'anything-ff-run-zgrep)
1389 (define-key map (kbd "M-.") 'anything-ff-run-etags)
1390 (define-key map (kbd "M-R") 'anything-ff-run-rename-file)
1391 (define-key map (kbd "M-C") 'anything-ff-run-copy-file)
1392 (define-key map (kbd "M-B") 'anything-ff-run-byte-compile-file)
1393 (define-key map (kbd "M-L") 'anything-ff-run-load-file)
1394 (define-key map (kbd "M-S") 'anything-ff-run-symlink-file)
1395 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1396 (define-key map (kbd "M-K") 'anything-ff-run-kill-buffer-persistent)
1397 (define-key map (kbd "M-e") 'anything-ff-run-switch-to-eshell)
1398 (define-key map (kbd "<M-tab>") 'anything-ff-run-complete-fn-at-point)
1399 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1400 (define-key map (kbd "C-c C-o") 'anything-ff-run-switch-other-frame)
1401 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1402 (define-key map (kbd "M-!") 'anything-ff-run-eshell-command-on-file)
1403 (define-key map (kbd "C-=") 'anything-ff-run-ediff-file)
1404 (define-key map (kbd "C-c =") 'anything-ff-run-ediff-merge-file)
1405 (define-key map (kbd "M-p") 'anything-ff-run-switch-to-history)
1406 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1407 (define-key map (kbd "C-c ?") 'anything-ff-help)
1408 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1409 (define-key map (kbd "M-a") 'anything-mark-all)
1410 (define-key map (kbd "M-m") 'anything-toggle-all-marks)
1411 (define-key map (kbd "M-u") 'anything-unmark-all)
1412 (define-key map (kbd "C-c C-a") 'anything-ff-run-gnus-attach-files)
1413 (define-key map (kbd "C-c p") 'anything-ff-run-print-file)
1414 ;; Next 2 have no effect if candidate is not an image file.
1415 (define-key map (kbd "M-l") 'anything-ff-rotate-left-persistent)
1416 (define-key map (kbd "M-r") 'anything-ff-rotate-right-persistent)
1417 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1418 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1419 (define-key map (kbd "C-h C-b") 'anything-send-bug-report-from-anything)
1420 (define-key map (kbd "C-h C-d") 'anything-debug-output)
1421 (when anything-ff-lynx-style-map
1422 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1423 (define-key map (kbd "<right>") 'anything-execute-persistent-action))
1424 (delq nil map))
1425 "Keymap for `anything-find-files'.")
1427 (defvar anything-c-read-file-map
1428 (let ((map (copy-keymap anything-map)))
1429 (define-key map (kbd "C-.") 'anything-find-files-down-one-level)
1430 (define-key map (kbd "C-l") 'anything-find-files-down-one-level)
1431 (define-key map (kbd "C-<backspace>") 'anything-ff-run-toggle-auto-update)
1432 (when anything-ff-lynx-style-map
1433 (define-key map (kbd "<left>") 'anything-find-files-down-one-level)
1434 (define-key map (kbd "<right>") 'anything-execute-persistent-action)
1435 (define-key map (kbd "<M-left>") 'anything-previous-source)
1436 (define-key map (kbd "<M-right>") 'anything-next-source))
1437 (delq nil map))
1438 "Keymap for `anything-c-read-file-name'.")
1440 (defvar anything-generic-files-map
1441 (let ((map (copy-keymap anything-map)))
1442 (define-key map (kbd "M-g s") 'anything-ff-run-grep)
1443 (define-key map (kbd "M-g p") 'anything-ff-run-pdfgrep)
1444 (define-key map (kbd "M-D") 'anything-ff-run-delete-file)
1445 (define-key map (kbd "C-o") 'anything-ff-run-switch-other-window)
1446 (define-key map (kbd "M-i") 'anything-ff-properties-persistent)
1447 (define-key map (kbd "C-c C-x") 'anything-ff-run-open-file-externally)
1448 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1449 (define-key map (kbd "C-c ?") 'anything-generic-file-help)
1450 map)
1451 "Generic Keymap for files.")
1453 (defvar anything-c-grep-map
1454 (let ((map (copy-keymap anything-map)))
1455 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1456 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1457 (define-key map (kbd "C-o") 'anything-c-grep-run-other-window-action)
1458 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1459 (define-key map (kbd "C-x C-s") 'anything-c-grep-run-save-buffer)
1460 (when anything-c-grep-use-ioccur-style-keys
1461 (define-key map (kbd "<right>") 'anything-c-grep-run-persistent-action)
1462 (define-key map (kbd "<left>") 'anything-c-grep-run-default-action))
1463 (define-key map (kbd "C-c ?") 'anything-grep-help)
1464 (delq nil map))
1465 "Keymap used in Grep sources.")
1467 (defvar anything-c-pdfgrep-map
1468 (let ((map (copy-keymap anything-map)))
1469 (define-key map (kbd "M-<down>") 'anything-c-goto-next-file)
1470 (define-key map (kbd "M-<up>") 'anything-c-goto-precedent-file)
1471 (define-key map (kbd "C-w") 'anything-yank-text-at-point)
1472 (define-key map (kbd "C-c ?") 'anything-pdfgrep-help)
1473 map)
1474 "Keymap used in pdfgrep.")
1476 (defvar anything-c-etags-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-w") 'anything-yank-text-at-point)
1481 (define-key map (kbd "C-c ?") 'anything-etags-help)
1482 map)
1483 "Keymap used in Etags.")
1485 (defvar anything-eval-expression-map
1486 (let ((map (copy-keymap anything-map)))
1487 (define-key map (kbd "<C-return>") 'anything-eval-new-line-and-indent)
1488 (define-key map (kbd "<tab>") 'lisp-indent-line)
1489 (define-key map (kbd "<C-tab>") 'lisp-complete-symbol)
1490 (define-key map (kbd "C-p") 'previous-line)
1491 (define-key map (kbd "C-n") 'next-line)
1492 (define-key map (kbd "<up>") 'previous-line)
1493 (define-key map (kbd "<down>") 'next-line)
1494 (define-key map (kbd "<right>") 'forward-char)
1495 (define-key map (kbd "<left>") 'backward-char)
1496 map))
1499 ;;; Embeded documentation.
1502 (defun anything-c-list-preconfigured-anything ()
1503 "Collect preconfigured anything functions in this file."
1504 (loop with doc
1505 with sym
1506 for entry in (cdr (assoc
1507 (file-truename (locate-library "anything-config"))
1508 load-history))
1509 if (and (consp entry)
1510 (eq (car entry) 'defun)
1511 (string-match "^Preconfigured.+$"
1512 (setq doc (or (documentation (setq sym (cdr entry)))
1513 ""))))
1514 collect (cons sym (match-string 0 doc))))
1516 (defun anything-c-format-preconfigured-anything ()
1517 (mapcar (lambda (x) (format "\\[%s] : %s\n" (car x) (cdr x)))
1518 (anything-c-list-preconfigured-anything)))
1520 ;;; Global help message - Used by `anything-help'
1523 (setq anything-help-message
1524 (lambda ()
1525 (concat
1526 "\\<anything-map>"
1527 "`anything' is QuickSilver-like candidate-selection framework.
1529 Narrow the list by typing some pattern,
1530 Multiple patterns are allowed by splitting by space.
1531 Select with natural Emacs operations, choose with RET.
1533 If you have any problems, press C-c C-x C-b!!
1534 Feel free to send bug reports. I'll fix them.
1535 The steps are described in the beginning of anything.el file.
1537 == Basic Operations ==
1538 C-p, Up: Previous Line
1539 C-n, Down : Next Line
1540 M-v, PageUp : Previous Page
1541 C-v, PageDown : Next Page
1542 Enter : Execute first (default) action / Select
1543 M-< : First Line
1544 M-> : Last Line
1545 M-PageUp, C-M-S-v, C-M-y : Previous Page (other-window)
1546 M-PageDown, C-M-v : Next Page (other-window)
1548 Tab, C-i : Show action list
1549 Left : Previous Source
1550 Right, C-o : Next Source
1551 C-k : Delete pattern
1552 C-z : Persistent Action (Execute action with anything session kept)
1553 C-c C-x C-b: Send a bug report
1555 == Shortcuts For 2nd/3rd Action ==
1556 \\[anything-select-2nd-action-or-end-of-line] : Execute 2nd Action (if the minibuffer cursor is at end of line)
1557 \\[anything-select-3rd-action] : Execute 3rd Action
1559 == Visible Marks ==
1560 Visible marks store candidate. Some actions uses marked candidates.
1562 \\[anything-toggle-visible-mark] : Toggle Visible Mark
1563 \\[anything-prev-visible-mark] : Previous Mark
1564 \\[anything-next-visible-mark] : Next Mark
1566 == Miscellaneous Commands ==
1567 \\[anything-toggle-resplit-window] : Toggle vertical/horizontal split anything window
1568 \\[anything-quit-and-find-file] : Drop into `find-file'
1569 \\[anything-delete-current-selection] : Delete Selected Item (visually)
1570 \\[anything-kill-selection-and-quit] : Set Item Into the kill-ring And Quit
1571 \\[anything-yank-selection] : Yank Selected Item Into Pattern
1572 \\[anything-follow-mode] : Toggle Automatical Execution Of Persistent Action
1573 \\[anything-force-update] : Recalculate And Redisplay Candidates
1575 == Global Commands ==
1576 \\<global-map>\\[anything-resume] revives last `anything' session.
1577 It is very useful, so you should bind any key.
1579 Single source is executed by \\[anything-call-source].
1581 == Preconfigured `anything' ==
1582 Preconfigured `anything' is commands that uses `anything' interface.
1583 You can use them without configuration.
1586 (apply 'concat (anything-c-format-preconfigured-anything))
1588 Enjoy!")))
1590 ;;; `anything-buffer-list' help
1593 ;;;###autoload
1594 (defun anything-c-buffer-help ()
1595 "Help command for anything buffers."
1596 (interactive)
1597 (let ((anything-help-message "== Anything Buffer ==
1598 \nTips:
1599 You can enter a partial name of major-mode (e.g lisp, sh) to narrow down buffers.
1600 Enter then a space and a pattern to narrow down to buffers matching this pattern.
1601 \nSpecific commands for `anything-buffers-list':
1602 \\<anything-c-buffer-map>
1603 \\[anything-buffer-run-grep]\t\t->Grep Buffer(s) (C-u grep all buffers linked to a file).
1604 \\[anything-buffer-run-zgrep]\t\t->Zgrep Buffer(s) (C-u grep all buffers linked to a file).
1605 \\[anything-buffer-switch-other-window]\t\t->Switch other window.
1606 \\[anything-buffer-switch-other-frame]\t\t->Switch other frame.
1607 \\[anything-buffer-run-query-replace-regexp]\t\t->Query replace regexp in marked buffers.
1608 \\[anything-buffer-run-query-replace]\t\t->Query replace in marked buffers.
1609 \\[anything-buffer-switch-to-elscreen]\t\t->Find buffer in Elscreen.
1610 \\[anything-buffer-diff-persistent]\t\t->Toggle Diff buffer without quitting.
1611 \\[anything-buffer-revert-persistent]\t\t->Revert buffer without quitting.
1612 \\[anything-buffer-save-persistent]\t\t->Save buffer without quitting.
1613 \\[anything-buffer-run-kill-buffers]\t\t->Delete marked buffers and quit.
1614 \\[anything-c-buffer-help]\t\t->Display this help.
1615 \n== Anything Map ==
1616 \\{anything-map}
1618 (anything-help)))
1621 ;;; Find files help (`anything-find-files')
1624 ;;;###autoload
1625 (defun anything-ff-help ()
1626 "Help command for `anything-find-files'."
1627 (interactive)
1628 (let ((anything-help-message "== Anything Find Files ==
1629 \nTips:
1630 \nEnter \"~/\" at anytime to reach home directory.
1631 Enter \"/\" at anytime to reach root of your file system.
1632 You can complete with partial basename \(e.g \"fb\" will complete \"foobar\"\).
1633 \nSpecific commands for `anything-find-files':
1634 \\<anything-find-files-map>
1635 \\[anything-ff-run-grep]\t\t->Run Grep (C-u Recursive).
1636 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1637 \\[anything-ff-run-zgrep]\t\t->Run zgrep (C-u Recursive).
1638 \\[anything-ff-run-etags]\t\t->Run Etags (C-u use thing-at-point `C-u C-u' reload cache)
1639 \\[anything-ff-run-rename-file]\t\t->Rename File (C-u Follow).
1640 \\[anything-ff-run-copy-file]\t\t->Copy File (C-u Follow).
1641 \\[anything-ff-run-byte-compile-file]\t\t->Byte Compile File (C-u Load).
1642 \\[anything-ff-run-load-file]\t\t->Load File.
1643 \\[anything-ff-run-symlink-file]\t\t->Symlink File.
1644 \\[anything-ff-run-delete-file]\t\t->Delete File.
1645 \\[anything-ff-run-kill-buffer-persistent]\t\t->Kill buffer candidate without quitting.
1646 \\[anything-ff-run-switch-to-eshell]\t\t->Switch to Eshell.
1647 \\[anything-ff-run-eshell-command-on-file]\t\t->Eshell command on file (C-u Run on all marked files at once).
1648 \\[anything-ff-run-ediff-file]\t\t->Ediff file.
1649 \\[anything-ff-run-ediff-merge-file]\t\t->Ediff merge file.
1650 \\[anything-ff-run-complete-fn-at-point]\t\t->Complete file name at point.
1651 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1652 \\[anything-ff-run-switch-other-frame]\t\t->Switch other frame.
1653 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1654 \\[anything-ff-rotate-left-persistent]\t\t->Rotate Image Left.
1655 \\[anything-ff-rotate-right-persistent]\t\t->Rotate Image Right.
1656 \\[anything-find-files-down-one-level]\t\t->Go down precedent directory.
1657 \\[anything-ff-run-switch-to-history]\t\t->Switch to anything find-files history.
1658 \\[anything-ff-properties-persistent]\t\t->Show file properties in a tooltip.
1659 \\[anything-mark-all]\t\t->Mark all visibles candidates.
1660 \\[anything-ff-run-toggle-auto-update]\t->Toggle auto expansion of directories.
1661 \\[anything-unmark-all]\t\t->Unmark all candidates, visibles and invisibles.
1662 \\[anything-ff-run-gnus-attach-files]\t\t->Gnus attach files to message buffer.
1663 \\[anything-ff-run-print-file]\t\t->Print file with default printer.
1664 \\[anything-send-bug-report-from-anything]\t\t->Send Bug report.
1665 \\[anything-ff-help]\t\t->Display this help info.
1666 \n== Anything Map ==
1667 \\{anything-map}
1669 (anything-help)))
1671 ;;; Generic file help - Used by locate.
1674 ;;;###autoload
1675 (defun anything-generic-file-help ()
1676 (interactive)
1677 (let ((anything-help-message "== Anything Generic files Map ==\
1678 \nSpecific commands for anything locate and others files sources:
1679 \\<anything-generic-files-map>
1680 \\[anything-ff-run-grep]\t\t->Run grep (C-u recurse).
1681 \\[anything-ff-run-pdfgrep]\t\t->Run Pdfgrep on marked files.
1682 \\[anything-ff-run-delete-file]\t\t->Delete file.
1683 \\[anything-ff-run-switch-other-window]\t\t->Switch other window.
1684 \\[anything-ff-properties-persistent]\t\t->Show file properties.
1685 \\[anything-yank-text-at-point]\t\t->Yank text at point.
1686 \\[anything-ff-run-open-file-externally]\t\t->Open file with external program (C-u to choose).
1687 \nLocate tips:
1688 You can add after writing search pattern any of the locate command line options.
1689 e.g -b, -e, -n <number>...etc.
1690 See Man locate for more infos.
1691 \n== Anything Map ==
1692 \\{anything-map}"))
1693 (anything-help)))
1696 ;;; Grep help
1699 ;;;###autoload
1700 (defun anything-grep-help ()
1701 (interactive)
1702 (let ((anything-help-message "== Anything Grep Map ==\
1703 \nSpecific commands for Grep and Etags:
1704 \\<anything-c-grep-map>
1705 \\[anything-c-goto-next-file]\t->Next File.
1706 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1707 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1708 \\[anything-c-grep-run-other-window-action]\t\t->Jump other window.
1709 \\[anything-c-grep-run-persistent-action]\t\t->Run persistent action (Same as `C-z').
1710 \\[anything-c-grep-run-default-action]\t\t->Run default action (Same as RET).
1711 \\[anything-grep-help]\t\t->Show this help.
1712 \n== Anything Map ==
1713 \\{anything-map}"))
1714 (anything-help)))
1716 ;;; Pdf grep help
1719 ;;;###autoload
1720 (defun anything-pdfgrep-help ()
1721 (interactive)
1722 (let ((anything-help-message "== Anything PdfGrep Map ==\
1723 \nSpecific commands for Pdf Grep:
1724 \\<anything-c-pdfgrep-map>
1725 \\[anything-c-goto-next-file]\t->Next File.
1726 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1727 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1728 \\[anything-pdfgrep-help]\t\t->Show this help.
1729 \n== Anything Map ==
1730 \\{anything-map}"))
1731 (anything-help)))
1733 ;;; Etags help
1736 ;;;###autoload
1737 (defun anything-etags-help ()
1738 "The help function for etags."
1739 (interactive)
1740 (let ((anything-help-message "== Anything Etags Map ==\
1741 \nSpecific commands for Etags:
1742 \\<anything-c-etags-map>
1743 \\[anything-c-goto-next-file]\t->Next File.
1744 \\[anything-c-goto-precedent-file]\t\t->Precedent File.
1745 \\[anything-yank-text-at-point]\t\t->Yank Text at point in minibuffer.
1746 \\[anything-etags-help]\t\t->Show this help.
1747 \n== Anything Map ==
1748 \\{anything-map}"))
1749 (anything-help)))
1751 ;;; Mode line strings
1754 (defvar anything-buffer-mode-line-string
1755 '("Buffer(s)"
1756 "\\<anything-c-buffer-map>\
1757 \\[anything-c-buffer-help]:Help, \
1758 \\<anything-map>\
1759 \\[anything-select-action]:Acts,\
1760 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1761 \\[anything-select-3rd-action]:NthAct,\
1762 \\[anything-send-bug-report-from-anything]:BugReport."
1763 "String displayed in mode-line in `anything-c-source-buffers-list'"))
1765 (defvar anything-ff-mode-line-string
1766 "\\<anything-find-files-map>\
1767 \\[anything-ff-help]:Help, \
1768 \\[anything-send-bug-report-from-anything]:BugReport, \
1769 \\<anything-map>\
1770 \\[anything-select-action]:Acts, \
1771 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1772 \\[anything-select-3rd-action]:NthAct"
1773 "String displayed in mode-line in `anything-c-source-find-files'")
1775 (defvar anything-generic-file-mode-line-string
1776 "\\<anything-generic-files-map>\
1777 \\[anything-generic-file-help]:Help, \
1778 \\<anything-map>\
1779 \\[anything-select-action]:Acts,\
1780 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1781 \\[anything-select-3rd-action]:NthAct,\
1782 \\[anything-send-bug-report-from-anything]:BugReport."
1783 "String displayed in mode-line in `anything-c-source-find-files'")
1785 (defvar anything-grep-mode-line-string
1786 "\\<anything-c-grep-map>\
1787 \\[anything-grep-help]:Help,\
1788 \\<anything-map>\
1789 \\[anything-select-action]:Acts,\
1790 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1791 \\[anything-select-3rd-action]:NthAct,\
1792 \\[anything-send-bug-report-from-anything]:BugReport."
1793 "String displayed in mode-line in `anything-do-grep'.")
1795 (defvar anything-pdfgrep-mode-line-string
1796 "\\<anything-c-pdfgrep-map>\
1797 \\[anything-pdfgrep-help]:Help,\
1798 \\<anything-map>\
1799 \\[anything-select-action]:Acts,\
1800 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1801 \\[anything-select-3rd-action]:NthAct,\
1802 \\[anything-send-bug-report-from-anything]:BugReport."
1803 "String displayed in mode-line in `anything-do-pdfgrep'.")
1805 (defvar anything-etags-mode-line-string
1806 "\\<anything-c-etags-map>\
1807 \\[anything-etags-help]:Help,\
1808 \\<anything-map>\
1809 \\[anything-select-action]:Acts,\
1810 \\[anything-exit-minibuffer]/\\[anything-select-2nd-action-or-end-of-line]/\
1811 \\[anything-select-3rd-action]:NthAct,\
1812 \\[anything-send-bug-report-from-anything]:BugReport."
1813 "String displayed in mode-line in `anything-c-etags-select'.")
1816 ;;; Preconfigured Anything
1819 ;;;###autoload
1820 (defun anything-mini ()
1821 "Preconfigured `anything' lightweight version \(buffer -> recentf\)."
1822 (interactive)
1823 (anything-other-buffer '(anything-c-source-buffers-list anything-c-source-recentf)
1824 "*anything mini*"))
1825 ;;;###autoload
1826 (defun anything-for-files ()
1827 "Preconfigured `anything' for opening files.
1828 ffap -> recentf -> buffer -> bookmark -> file-cache -> files-in-current-dir -> locate."
1829 (interactive)
1830 (anything-other-buffer anything-for-files-prefered-list "*anything for files*"))
1832 ;;;###autoload
1833 (defun anything-recentf ()
1834 "Preconfigured `anything' for `recentf'."
1835 (interactive)
1836 (anything-other-buffer 'anything-c-source-recentf "*anything recentf*"))
1838 ;;;###autoload
1839 (defun anything-info-at-point (arg)
1840 "Preconfigured `anything' for searching info at point.
1841 With a prefix-arg insert symbol at point."
1842 (interactive "P")
1843 (let ((anything-c-google-suggest-default-function
1844 'anything-c-google-suggest-emacs-lisp))
1845 (anything :sources'(anything-c-source-info-elisp
1846 anything-c-source-info-cl
1847 anything-c-source-info-pages
1848 anything-c-source-google-suggest)
1849 :input (and arg (thing-at-point 'symbol))
1850 :buffer "*anything info*")))
1852 ;;;###autoload
1853 (defun anything-info-emacs ()
1854 "Preconfigured anything for Emacs manual index."
1855 (interactive)
1856 (anything-other-buffer 'anything-c-source-info-emacs "*info emacs*"))
1858 ;;;###autoload
1859 (defun anything-show-kill-ring ()
1860 "Preconfigured `anything' for `kill-ring'.
1861 It is drop-in replacement of `yank-pop'.
1862 You may bind this command to M-y.
1863 First call open the kill-ring browser, next calls move to next line."
1864 (interactive)
1865 (let ((buf "*anything kill-ring*"))
1866 (if (get-buffer-window buf)
1867 (with-anything-window
1868 (if (eq (point) (save-excursion
1869 (anything-end-of-buffer) (point)))
1870 (anything-beginning-of-buffer)
1871 (anything-next-line)))
1872 (anything-other-buffer 'anything-c-source-kill-ring buf))))
1874 ;;;###autoload
1875 (defun anything-minibuffer-history ()
1876 "Preconfigured `anything' for `minibuffer-history'."
1877 (interactive)
1878 (let ((enable-recursive-minibuffers t))
1879 (anything-other-buffer 'anything-c-source-minibuffer-history
1880 "*anything minibuffer-history*")))
1882 ;;;###autoload
1883 (defun anything-gentoo ()
1884 "Preconfigured `anything' for gentoo linux."
1885 (interactive)
1886 (anything-other-buffer '(anything-c-source-gentoo
1887 anything-c-source-use-flags)
1888 "*anything gentoo*"))
1890 ;;;###autoload
1891 (defun anything-imenu ()
1892 "Preconfigured `anything' for `imenu'."
1893 (interactive)
1894 (anything 'anything-c-source-imenu nil nil nil nil "*anything imenu*"))
1896 ;;;###autoload
1897 (defun anything-google-suggest ()
1898 "Preconfigured `anything' for google search with google suggest."
1899 (interactive)
1900 (anything-other-buffer 'anything-c-source-google-suggest "*anything google*"))
1902 ;;;###autoload
1903 (defun anything-yahoo-suggest ()
1904 "Preconfigured `anything' for Yahoo searching with Yahoo suggest."
1905 (interactive)
1906 (anything-other-buffer 'anything-c-source-yahoo-suggest "*anything yahoo*"))
1908 ;;; Converted from anything-show-*-only
1909 ;;;###autoload
1910 (defun anything-for-buffers ()
1911 "Preconfigured `anything' for buffer."
1912 (interactive)
1913 (anything-other-buffer 'anything-c-source-buffers "*anything for buffers*"))
1915 ;;;###autoload
1916 (defun anything-buffers-list ()
1917 "Enhanced preconfigured `anything' for buffer."
1918 (interactive)
1919 (anything :sources '(anything-c-source-buffers-list
1920 anything-c-source-buffer-not-found)
1921 :buffer "*anything buffers*" :keymap anything-c-buffer-map))
1923 ;;;###autoload
1924 (defun anything-bbdb ()
1925 "Preconfigured `anything' for BBDB.
1927 Needs BBDB.
1929 http://bbdb.sourceforge.net/"
1930 (interactive)
1931 (anything-other-buffer 'anything-c-source-bbdb "*anything bbdb*"))
1933 ;;;###autoload
1934 (defun anything-locate (arg)
1935 "Preconfigured `anything' for Locate.
1936 Note: you can add locate options after entering pattern.
1937 See 'man locate' for valid options.
1939 You can specify a specific database with prefix argument ARG \(C-u\).
1940 Many databases can be used: navigate and mark them.
1941 See also `anything-locate-with-db'.
1943 To create a user specific db, use
1944 \"updatedb -l 0 -o db_path -U directory\".
1945 Where db_path is a filename matched by
1946 `anything-locate-db-file-regexp'."
1947 (interactive "P")
1948 (let* ((db (and arg
1949 (anything-c-read-file-name
1950 "LocateDBFiles: "
1951 :marked-candidates t
1952 :preselect anything-locate-db-file-regexp
1953 :test #'(lambda (x)
1954 (if anything-locate-db-file-regexp
1955 ;; Select only locate db files and directories
1956 ;; to allow navigation.
1957 (or (string-match
1958 anything-locate-db-file-regexp x)
1959 (file-directory-p x))
1960 x))))))
1961 (anything-locate-with-db db)))
1963 ;;;###autoload
1964 (defun anything-w3m-bookmarks ()
1965 "Preconfigured `anything' for w3m bookmark.
1967 Needs w3m and emacs-w3m.
1969 http://w3m.sourceforge.net/
1970 http://emacs-w3m.namazu.org/"
1971 (interactive)
1972 (anything-other-buffer 'anything-c-source-w3m-bookmarks
1973 "*anything w3m bookmarks*"))
1975 ;;;###autoload
1976 (defun anything-firefox-bookmarks ()
1977 "Preconfigured `anything' for firefox bookmark.
1978 You will have to enable html bookmarks in firefox:
1979 open about:config in firefox and double click on this line to enable value \
1980 to true:
1982 user_pref(\"browser.bookmarks.autoExportHTML\", false);
1984 You should have now:
1986 user_pref(\"browser.bookmarks.autoExportHTML\", true);
1988 After closing firefox, you will be able to browse you bookmarks.
1990 (interactive)
1991 (anything-other-buffer 'anything-c-source-firefox-bookmarks
1992 "*Anything Firefox*"))
1994 ;;;###autoload
1995 (defun anything-colors ()
1996 "Preconfigured `anything' for color."
1997 (interactive)
1998 (anything-other-buffer
1999 '(anything-c-source-colors anything-c-source-customize-face)
2000 "*anything colors*"))
2002 ;;;###autoload
2003 (defun anything-bookmarks ()
2004 "Preconfigured `anything' for bookmarks."
2005 (interactive)
2006 (anything-other-buffer 'anything-c-source-bookmarks "*anything bookmarks*"))
2008 ;;;###autoload
2009 (defun anything-c-pp-bookmarks ()
2010 "Preconfigured `anything' for bookmarks (pretty-printed)."
2011 (interactive)
2012 (anything-other-buffer '(anything-c-source-bookmarks-local
2013 anything-c-source-bookmarks-su
2014 anything-c-source-bookmarks-ssh)
2015 "*anything pp bookmarks*"))
2017 ;;;###autoload
2018 (defun anything-c-insert-latex-math ()
2019 "Preconfigured anything for latex math symbols completion."
2020 (interactive)
2021 (anything-other-buffer 'anything-c-source-latex-math "*anything latex*"))
2023 ;;;###autoload
2024 (defun anything-register ()
2025 "Preconfigured `anything' for Emacs registers."
2026 (interactive)
2027 (anything-other-buffer 'anything-c-source-register "*anything register*"))
2029 ;;;###autoload
2030 (defun anything-man-woman ()
2031 "Preconfigured `anything' for Man and Woman pages."
2032 (interactive)
2033 (anything-other-buffer 'anything-c-source-man-pages "*Anything man woman*"))
2035 ;;;###autoload
2036 (defun anything-org-keywords ()
2037 "Preconfigured `anything' for org keywords."
2038 (interactive)
2039 (anything-other-buffer 'anything-c-source-org-keywords "*org keywords*"))
2041 ;;;###autoload
2042 (defun anything-emms ()
2043 "Preconfigured `anything' for emms sources."
2044 (interactive)
2045 (anything '(anything-c-source-emms-streams
2046 anything-c-source-emms-files
2047 anything-c-source-emms-dired)
2048 nil nil nil nil
2049 "*Anything Emms*"))
2051 ;;;###autoload
2052 (defun anything-eev-anchors ()
2053 "Preconfigured `anything' for eev anchors."
2054 (interactive)
2055 (anything-other-buffer 'anything-c-source-eev-anchor "*Anything eev anchors*"))
2057 ;;;###autoload
2058 (defun anything-bm-list ()
2059 "Preconfigured `anything' for visible bookmarks.
2061 Needs bm.el
2063 http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el"
2064 (interactive)
2065 (let ((anything-outline-using t))
2066 (anything-other-buffer 'anything-c-source-bm "*anything bm list*")))
2068 ;;;###autoload
2069 (defun anything-timers ()
2070 "Preconfigured `anything' for timers."
2071 (interactive)
2072 (anything-other-buffer '(anything-c-source-absolute-time-timers
2073 anything-c-source-idle-time-timers)
2074 "*anything timers*"))
2076 ;;;###autoload
2077 (defun anything-list-emacs-process ()
2078 "Preconfigured `anything' for emacs process."
2079 (interactive)
2080 (anything-other-buffer 'anything-c-source-emacs-process "*anything process*"))
2082 ;;;###autoload
2083 (defun anything-occur ()
2084 "Preconfigured Anything for Occur source.
2085 If region is active, search only in region,
2086 otherwise search in whole buffer."
2087 (interactive)
2088 (let ((anything-compile-source-functions
2089 ;; rule out anything-match-plugin because the input is one regexp.
2090 (delq 'anything-compile-source--match-plugin
2091 (copy-sequence anything-compile-source-functions))))
2092 (anything-other-buffer 'anything-c-source-occur "*Anything Occur*")))
2094 ;;;###autoload
2095 (defun anything-browse-code ()
2096 "Preconfigured anything to browse code."
2097 (interactive)
2098 (anything-other-buffer 'anything-c-source-browse-code "*Browse code*"))
2100 ;;;###autoload
2101 (defun anything-org-headlines ()
2102 "Preconfigured anything to show org headlines."
2103 (interactive)
2104 (anything-other-buffer 'anything-c-source-org-headline "*org headlines*"))
2106 ;;;###autoload
2107 (defun anything-info-gnus ()
2108 "Preconfigured anything to browse Gnus Manual."
2109 (interactive)
2110 (anything-other-buffer 'anything-c-source-info-gnus "*info Gnus*"))
2112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Anything Applications ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2114 ;;; Anything regexp.
2117 (defun anything-c-query-replace-regexp (candidate)
2118 "Query replace regexp from `anything-regexp'.
2119 With a prefix arg replace only matches surrounded by word boundaries,
2120 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
2121 (let ((regexp (funcall (anything-attr 'regexp))))
2122 (apply 'query-replace-regexp
2123 (anything-c-query-replace-args regexp))))
2125 (defun anything-c-kill-regexp-as-sexp (candidate)
2126 "Kill regexp in a format usable in lisp code."
2127 (anything-c-regexp-kill-new
2128 (prin1-to-string (funcall (anything-attr 'regexp)))))
2130 (defun anything-c-kill-regexp (candidate)
2131 "Kill regexp as it is in `anything-pattern'."
2132 (anything-c-regexp-kill-new (funcall (anything-attr 'regexp))))
2134 (defun anything-c-query-replace-args (regexp)
2135 "create arguments of `query-replace-regexp' action in `anything-regexp'."
2136 (let ((region-only (anything-region-active-p)))
2137 (list
2138 regexp
2139 (query-replace-read-to regexp
2140 (format "Query replace %sregexp %s"
2141 (if anything-current-prefix-arg "word " "")
2142 (if region-only "in region " ""))
2144 anything-current-prefix-arg
2145 (when region-only (region-beginning))
2146 (when region-only (region-end)))))
2148 (defvar anything-c-source-regexp
2149 '((name . "Regexp Builder")
2150 (init . (lambda ()
2151 (anything-candidate-buffer anything-current-buffer)))
2152 (candidates-in-buffer)
2153 (get-line . anything-c-regexp-get-line)
2154 (persistent-action . anything-c-regexp-persistent-action)
2155 (persistent-help . "Show this line")
2156 (multiline)
2157 (delayed)
2158 (requires-pattern . 2)
2159 (mode-line . "Press TAB to select action.")
2160 (regexp . (lambda () anything-input))
2161 (action . (("Kill Regexp as sexp" . anything-c-kill-regexp-as-sexp)
2162 ("Query Replace Regexp (C-u Not inside word.)"
2163 . anything-c-query-replace-regexp)
2164 ("Kill Regexp" . anything-c-kill-regexp)))))
2166 (defun anything-c-regexp-get-line (s e)
2167 (propertize
2168 (apply 'concat
2169 ;; Line contents
2170 (format "%5d: %s" (line-number-at-pos (1- s)) (buffer-substring s e))
2171 ;; subexps
2172 (loop for i from 0 to (1- (/ (length (match-data)) 2))
2173 collect (format "\n %s'%s'"
2174 (if (zerop i) "Group 0: " (format "Group %d: " i))
2175 (match-string i))))
2176 ;; match beginning
2177 ;; KLUDGE: point of anything-candidate-buffer is +1 than that of anything-current-buffer.
2178 ;; It is implementation problem of candidates-in-buffer.
2179 'anything-realvalue
2180 (1- s)))
2182 (defun anything-goto-line (lineno)
2183 "Goto LINENO opening only outline headline if needed."
2184 (goto-char (point-min)) (forward-line (1- lineno))
2185 (when (or (eq major-mode 'org-mode) outline-minor-mode)
2186 (org-reveal))
2187 (anything-match-line-color-current-line) (sit-for 0.3)
2188 (anything-match-line-cleanup))
2190 (defun anything-c-regexp-persistent-action (pt)
2191 (goto-char pt)
2192 (anything-persistent-highlight-point))
2194 (defun anything-c-regexp-kill-new (input)
2195 (kill-new input)
2196 (message "Killed: %s" input))
2198 (defun anything-region-active-p ()
2199 (and transient-mark-mode mark-active (/= (mark) (point))))
2201 (defun* anything-current-buffer-narrowed-p (&optional
2202 (buffer anything-current-buffer))
2203 "Check if BUFFER is narrowed.
2204 Default is `anything-current-buffer'."
2205 (with-current-buffer buffer
2206 (let ((beg (point-min))
2207 (end (point-max))
2208 (total (buffer-size)))
2209 (or (/= beg 1) (/= end (1+ total))))))
2211 ;;;###autoload
2212 (defun anything-regexp ()
2213 "Preconfigured anything to build regexps and run query-replace-regexp \
2214 against."
2215 (interactive)
2216 (save-restriction
2217 (let ((anything-compile-source-functions
2218 ;; rule out anything-match-plugin because the input is one regexp.
2219 (delq 'anything-compile-source--match-plugin
2220 (copy-sequence anything-compile-source-functions))))
2221 (when (and (anything-region-active-p)
2222 ;; Don't narrow to region if buffer is already narrowed.
2223 (not (anything-current-buffer-narrowed-p)))
2224 (narrow-to-region (region-beginning) (region-end)))
2225 (anything :sources
2226 anything-c-source-regexp
2227 :buffer "*anything regexp*"
2228 :prompt "Regexp: "))))
2231 ;;; Utilities Functions
2234 (defun anything-test-sources ()
2235 "List all anything sources for test.
2236 The output is sexps which are evaluated by \\[eval-last-sexp]."
2237 (interactive)
2238 (with-output-to-temp-buffer "*Anything Test Sources*"
2239 (mapc (lambda (s) (princ (format ";; (anything '%s)\n" s)))
2240 (apropos-internal "^anything-c-source" #'boundp))
2241 (pop-to-buffer standard-output)))
2243 (defun anything-nest (&rest same-as-anything)
2244 "Nested `anything'. If you use `anything' within `anything', use it."
2245 (with-selected-window (anything-window)
2246 (let (anything-current-position
2247 anything-current-buffer
2248 (orig-anything-buffer anything-buffer)
2249 anything-pattern
2250 anything-buffer
2251 anything-sources
2252 anything-compiled-sources
2253 anything-buffer-chars-modified-tick
2254 (anything-samewindow t)
2255 (enable-recursive-minibuffers t))
2256 (unwind-protect
2257 (apply #'anything same-as-anything)
2258 (anything-initialize-overlays orig-anything-buffer)
2259 (add-hook 'post-command-hook 'anything-check-minibuffer-input)))))
2261 (defun anything-displaying-source-names ()
2262 "Display sources name."
2263 (with-current-buffer anything-buffer
2264 (goto-char (point-min))
2265 (loop with pos
2266 while (setq pos (next-single-property-change (point) 'anything-header))
2267 do (goto-char pos)
2268 collect (buffer-substring-no-properties (point-at-bol)(point-at-eol))
2269 do (forward-line 1))))
2271 (defun anything-select-source ()
2272 "Select source."
2273 (interactive)
2274 (let ((default (assoc-default 'name (anything-get-current-source)))
2275 (source-names (anything-displaying-source-names))
2276 (all-source-names (mapcar (lambda (s) (assoc-default 'name s))
2277 (anything-get-sources))))
2278 (setq anything-candidate-number-limit 9999)
2279 (anything-aif
2280 (let (anything-source-filter)
2281 (anything-nest '(((name . "Anything Source")
2282 (candidates . source-names)
2283 (action . identity))
2284 ((name . "Anything Source (ALL)")
2285 (candidates . all-source-names)
2286 (action . identity)))
2287 nil "Source: " nil
2288 default "*anything select source*"))
2289 (anything-set-source-filter (list it))
2290 (anything-set-source-filter nil))))
2292 (defun anything-c-match-on-file-name (candidate)
2293 "Return non-nil if `anything-pattern' match basename of filename CANDIDATE."
2294 (string-match anything-pattern (file-name-nondirectory candidate)))
2296 (defun anything-c-match-on-directory-name (candidate)
2297 "Return non-nil if `anything-pattern' match directory part of CANDIDATE."
2298 (anything-aif (file-name-directory candidate)
2299 (string-match anything-pattern it)))
2301 (defun anything-c-string-match (candidate)
2302 "Return non-nil if `anything-pattern' match CANDIDATE.
2303 The match is done with `string-match'."
2304 (string-match anything-pattern candidate))
2306 ;; `anything-c-compose' is no more needed, it is for compatibility.
2307 (defalias 'anything-c-compose 'anything-compose)
2309 (defun anything-c-skip-entries (list regexp)
2310 "Remove entries which matches REGEXP from LIST."
2311 (remove-if (lambda (x) (and (stringp x) (string-match regexp x)))
2312 list))
2314 (defun anything-c-shadow-entries (list regexp)
2315 "Display elements of LIST matching REGEXP with the `file-name-shadow' face."
2316 (mapcar (lambda (file)
2317 ;; Add shadow face property to boring files.
2318 (let ((face (if (facep 'file-name-shadow)
2319 'file-name-shadow
2320 ;; fall back to default on XEmacs
2321 'default)))
2322 (if (string-match regexp file)
2323 (setq file (propertize file 'face face))))
2324 file)
2325 list))
2327 (defsubst anything-c-stringify (str-or-sym)
2328 "Get string of STR-OR-SYM."
2329 (if (stringp str-or-sym)
2330 str-or-sym
2331 (symbol-name str-or-sym)))
2333 (defsubst anything-c-symbolify (str-or-sym)
2334 "Get symbol of STR-OR-SYM."
2335 (if (symbolp str-or-sym)
2336 str-or-sym
2337 (intern str-or-sym)))
2339 (defun anything-c-describe-function (func)
2340 "FUNC is symbol or string."
2341 (describe-function (anything-c-symbolify func)))
2343 (defun anything-c-describe-variable (var)
2344 "VAR is symbol or string."
2345 (describe-variable (anything-c-symbolify var)))
2347 (defun anything-c-find-function (func)
2348 "FUNC is symbol or string."
2349 (find-function (anything-c-symbolify func)))
2351 (defun anything-c-find-variable (var)
2352 "VAR is symbol or string."
2353 (find-variable (anything-c-symbolify var)))
2355 (defun anything-c-kill-new (candidate &optional replace)
2356 "CANDIDATE is symbol or string.
2357 See `kill-new' for argument REPLACE."
2358 (kill-new (anything-c-stringify candidate) replace))
2360 ;;; Toggle all marks.
2363 ;;;###autoload
2364 (defun anything-mark-all ()
2365 "Mark all visible unmarked candidates in current source."
2366 (interactive)
2367 (with-anything-window
2368 (save-excursion
2369 (goto-char (anything-get-previous-header-pos))
2370 (anything-next-line)
2371 (let* ((next-head (anything-get-next-header-pos))
2372 (end (and next-head
2373 (save-excursion
2374 (goto-char next-head)
2375 (forward-line -2)
2376 (point))))
2377 (maxpoint (or end (point-max))))
2378 (while (< (point) maxpoint)
2379 (anything-mark-current-line)
2380 (let ((prefix (get-text-property (point-at-bol) 'display))
2381 (bn (anything-c-basename (anything-get-selection)))
2382 (src (assoc-default 'name (anything-get-current-source))))
2383 (when (and (not (anything-this-visible-mark))
2384 (not (or (string= prefix "[?]")
2385 (string= prefix "[@]"))))
2386 ;; Don't mark possibles directories ending with . or ..
2387 ;; and also autosave files/links.
2388 (unless
2389 (and (or (anything-file-completion-source-p)
2390 (equal src "Files from Current Directory"))
2391 (string-match "^\\.#.*\\|^#.*#$\\|\\.$" bn))
2392 (anything-make-visible-mark))))
2393 (forward-line 1) (end-of-line))))
2394 (anything-mark-current-line)
2395 (message "%s candidates marked" (length anything-marked-candidates))))
2397 ;;;###autoload
2398 (defun anything-unmark-all ()
2399 "Unmark all candidates in all sources of current anything session."
2400 (interactive)
2401 (with-anything-window
2402 (let ((len (length anything-marked-candidates)))
2403 (save-excursion
2404 (anything-clear-visible-mark))
2405 (setq anything-marked-candidates nil)
2406 (anything-mark-current-line)
2407 (message "%s candidates unmarked" len))))
2409 ;;;###autoload
2410 (defun anything-toggle-all-marks ()
2411 "Toggle all marks.
2412 Mark all visible candidates of current source or unmark all candidates
2413 visible or invisible in all sources of current anything session"
2414 (interactive)
2415 (let ((marked (anything-marked-candidates)))
2416 (if (and (>= (length marked) 1)
2417 (with-anything-window anything-visible-mark-overlays))
2418 (anything-unmark-all)
2419 (anything-mark-all))))
2421 (define-key anything-map (kbd "M-m") 'anything-toggle-all-marks)
2424 (defadvice eval-defun (after anything-source-hack activate)
2425 "Allow immediate execution of anything source when evaling it.
2426 See `anything-c-enable-eval-defun-hack'."
2427 (when anything-c-enable-eval-defun-hack
2428 (let ((varsym (save-excursion
2429 (beginning-of-defun)
2430 (forward-char 1)
2431 (when (memq (read (current-buffer)) '(defvar setq))
2432 (read (current-buffer))))))
2433 (when (string-match "^anything-c-source-" (symbol-name varsym))
2434 (anything varsym)))))
2435 ;; (progn (ad-disable-advice 'eval-defun 'after 'anything-source-hack) (ad-update 'eval-defun))
2437 ;;; Buffers
2440 (defun anything-c-buffer-list ()
2441 "Return the list of names of buffers with boring buffers filtered out.
2442 Boring buffers is specified by `anything-c-boring-buffer-regexp'.
2443 The first buffer in the list will be the last recently used
2444 buffer that is not the current buffer."
2445 (let ((buffers (mapcar 'buffer-name (buffer-list))))
2446 (append (cdr buffers) (list (car buffers)))))
2448 (defvar anything-c-source-buffers
2449 '((name . "Buffers")
2450 (candidates . anything-c-buffer-list)
2451 (type . buffer)))
2452 ;; (anything 'anything-c-source-buffers)
2454 (defvar anything-c-source-buffer-not-found
2455 '((name . "Create buffer")
2456 (dummy)
2457 (filtered-candidate-transformer (lambda (cands source)
2458 (list anything-pattern)))
2459 (action . (lambda (candidate)
2460 (anything-c-switch-to-buffer (get-buffer-create candidate))))))
2461 ;; (anything 'anything-c-source-buffer-not-found)
2463 ;;; Buffers+
2466 (eval-when-compile (require 'dired))
2468 (defun anything-c-highlight-buffers (buffers)
2469 (loop for i in buffers
2470 for buf = (get-buffer i)
2471 for bfname = (buffer-file-name buf)
2472 collect
2473 (cond (;; A dired buffer.
2474 (rassoc buf dired-buffers)
2475 (propertize i 'face 'anything-ff-directory
2476 'help-echo (car (rassoc buf dired-buffers))))
2477 ;; A buffer file modified somewhere outside of emacs.
2478 ((and bfname (not (file-remote-p bfname))
2479 (file-exists-p bfname)
2480 (not (verify-visited-file-modtime buf)))
2481 (propertize i 'face 'anything-buffer-saved-out
2482 'help-echo bfname))
2483 ;; A new buffer file not already saved on disk.
2484 ((and bfname (not (file-remote-p bfname))
2485 (not (verify-visited-file-modtime buf)))
2486 (propertize i 'face 'anything-buffer-not-saved
2487 'help-echo bfname))
2488 ;; A Remote buffer file modified and not saved on disk.
2489 ((and bfname (file-remote-p bfname) (buffer-modified-p buf))
2490 (let ((prefix (propertize
2491 " " 'display
2492 (propertize "@ " 'face 'anything-ff-prefix))))
2493 (cons (concat prefix (propertize i 'face 'anything-ff-symlink
2494 'help-echo bfname)) i)))
2495 ;; A buffer file modified and not saved on disk.
2496 ((and bfname (buffer-modified-p buf))
2497 (propertize i 'face 'anything-ff-symlink
2498 'help-echo bfname))
2499 ;; A remote buffer file not modified and saved on disk.
2500 ((and bfname (file-remote-p bfname))
2501 (let ((prefix (propertize
2502 " " 'display
2503 (propertize "@ " 'face 'anything-ff-prefix))))
2504 (cons (concat prefix (propertize i 'face 'font-lock-type-face
2505 'help-echo bfname)) i)))
2506 ;; A buffer file not modified and saved on disk.
2507 (bfname
2508 (propertize i 'face 'font-lock-type-face
2509 'help-echo bfname))
2510 ;; Any non--file buffer.
2511 (t (propertize i 'face 'italic)))))
2514 (defvar anything-c-source-buffers-list
2515 '((name . "Buffers")
2516 (candidates . anything-c-buffer-list)
2517 (type . buffer)
2518 (match anything-c-buffer-match-major-mode)
2519 (diff-action . anything-buffer-toggle-diff)
2520 (revert-action . anything-buffer-revert-and-update)
2521 (save-action . anything-buffer-save-and-update)
2522 (candidate-transformer anything-c-skip-current-buffer
2523 anything-c-skip-boring-buffers
2524 anything-c-highlight-buffers)
2525 (persistent-action . anything-c-buffers-list-persistent-action)
2526 (volatile)
2527 (mode-line . anything-buffer-mode-line-string)
2528 (persistent-help . "Show this buffer / C-u \\[anything-execute-persistent-action]: Kill this buffer")))
2530 (defun anything-c-buffer-match-major-mode (candidate)
2531 "Match maybe buffer by major-mode.
2532 If you give a major-mode or partial major-mode,
2533 it will list all buffers of this major-mode and/or buffers with name
2534 matching this major-mode.
2535 If you add a space after major-mode and then a space,
2536 it will match all buffers of the major-mode
2537 before space matching pattern after space.
2538 If you give a pattern which doesn't match a major-mode, it will search buffer
2539 with name matching pattern."
2540 (let* ((cand (replace-regexp-in-string "^\\s-\\{1\\}" "" candidate))
2541 (buf (get-buffer cand)))
2542 (when buf
2543 (with-current-buffer buf
2544 (let ((mjm (symbol-name major-mode))
2545 (split (split-string anything-pattern)))
2546 (cond ((string-match "\\s-$" anything-pattern)
2547 (string-match (car split) mjm))
2548 ((string-match "\\s-" anything-pattern)
2549 (and (string-match (car split) mjm)
2550 (string-match (cadr split) cand)))
2551 (t (or (string-match anything-pattern mjm)
2552 (string-match anything-pattern cand)))))))))
2554 (defun anything-c-buffer-query-replace-1 (&optional regexp-flag)
2555 "Query replace in marked buffers.
2556 If REGEXP-FLAG is given use `query-replace-regexp'."
2557 (let ((fn (if regexp-flag 'query-replace-regexp 'query-replace))
2558 (prompt (if regexp-flag "Query replace regexp" "Query replace"))
2559 (bufs (anything-marked-candidates)))
2560 (loop
2561 with replace = (query-replace-read-from prompt regexp-flag)
2562 with tostring = (unless (consp replace)
2563 (query-replace-read-to
2564 replace prompt regexp-flag))
2565 for buf in bufs
2567 (save-window-excursion
2568 (anything-c-switch-to-buffer buf)
2569 (save-excursion
2570 (let ((case-fold-search t))
2571 (goto-char (point-min))
2572 (if (consp replace)
2573 (apply fn (list (car replace) (cdr replace)))
2574 (apply fn (list replace tostring)))))))))
2576 (defun anything-c-buffer-query-replace-regexp (candidate)
2577 (anything-c-buffer-query-replace-1 'regexp))
2579 (defun anything-c-buffer-query-replace (candidate)
2580 (anything-c-buffer-query-replace-1))
2582 (defun anything-buffer-toggle-diff (candidate)
2583 "Toggle diff buffer CANDIDATE with it's file."
2584 (if (get-buffer-window "*Diff*")
2585 (kill-buffer "*Diff*")
2586 (diff-buffer-with-file (get-buffer candidate))))
2588 ;;;###autoload
2589 (defun anything-buffer-diff-persistent ()
2590 "Toggle diff buffer without quitting anything."
2591 (interactive)
2592 (anything-execute-persistent-action 'diff-action))
2594 (defun anything-buffer-revert-and-update (candidate)
2595 (let ((marked (anything-marked-candidates)))
2596 (loop for buf in marked do (anything-revert-buffer buf))
2597 (anything-force-update)
2598 (anything-c-recenter-window)))
2600 ;;;###autoload
2601 (defun anything-buffer-revert-persistent ()
2602 "Revert buffer without quitting anything."
2603 (interactive)
2604 (anything-execute-persistent-action 'revert-action))
2606 (defun anything-buffer-save-and-update (candidate)
2607 (let ((marked (anything-marked-candidates))
2608 (enable-recursive-minibuffers t))
2609 (loop for buf in marked do
2610 (with-current-buffer (get-buffer buf)
2611 (save-buffer)))
2612 (anything-force-update)
2613 (anything-c-recenter-window)))
2615 ;;;###autoload
2616 (defun anything-buffer-save-persistent ()
2617 "Save buffer without quitting anything."
2618 (interactive)
2619 (anything-execute-persistent-action 'save-action))
2621 ;;;###autoload
2622 (defun anything-buffer-run-kill-buffers ()
2623 "Run kill buffer action from `anything-c-source-buffer+'."
2624 (interactive)
2625 (anything-c-quit-and-execute-action 'anything-kill-marked-buffers))
2627 ;;;###autoload
2628 (defun anything-buffer-run-grep ()
2629 "Run Grep action from `anything-c-source-buffer+'."
2630 (interactive)
2631 (anything-c-quit-and-execute-action 'anything-c-grep-buffers))
2633 ;;;###autoload
2634 (defun anything-buffer-run-zgrep ()
2635 "Run Grep action from `anything-c-source-buffer+'."
2636 (interactive)
2637 (anything-c-quit-and-execute-action 'anything-c-zgrep-buffers))
2639 ;;;###autoload
2640 (defun anything-buffer-run-query-replace-regexp ()
2641 "Run Query replace regexp action from `anything-c-source-buffer+'."
2642 (interactive)
2643 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace-regexp))
2645 ;;;###autoload
2646 (defun anything-buffer-run-query-replace ()
2647 "Run Query replace action from `anything-c-source-buffer+'."
2648 (interactive)
2649 (anything-c-quit-and-execute-action 'anything-c-buffer-query-replace))
2651 ;;;###autoload
2652 (defun anything-buffer-switch-other-window ()
2653 "Run switch to other window action from `anything-c-source-buffer+'."
2654 (interactive)
2655 (anything-c-quit-and-execute-action 'switch-to-buffer-other-window))
2657 ;;;###autoload
2658 (defun anything-buffer-switch-other-frame ()
2659 "Run switch to other frame action from `anything-c-source-buffer+'."
2660 (interactive)
2661 (anything-c-quit-and-execute-action 'switch-to-buffer-other-frame))
2663 ;;;###autoload
2664 (defun anything-buffer-switch-to-elscreen ()
2665 "Run switch to elscreen action from `anything-c-source-buffer+'."
2666 (interactive)
2667 (anything-c-quit-and-execute-action 'anything-find-buffer-on-elscreen))
2669 (defun anything-c-buffers-persistent-kill (buffer)
2670 "Persistent action to kill buffer."
2671 (with-current-buffer (get-buffer buffer)
2672 (if (and (buffer-modified-p)
2673 (buffer-file-name (current-buffer)))
2674 (progn
2675 (save-buffer)
2676 (kill-buffer buffer))
2677 (kill-buffer buffer)))
2678 (anything-delete-current-selection))
2680 (defun anything-c-recenter-window ()
2681 "Make visible current selection by recentering anything window."
2682 (with-anything-window (recenter)))
2684 (defun anything-c-buffers-list-persistent-action (candidate)
2685 (if current-prefix-arg
2686 (anything-c-buffers-persistent-kill candidate)
2687 (anything-c-switch-to-buffer candidate)))
2689 ;; (anything 'anything-c-source-buffers-list)
2691 (defadvice anything-quit-and-find-file (around use-anything-find-files activate)
2692 "Let `anything-quit-and-find-file' take advantage of `anything-find-files'."
2693 (interactive)
2694 (anything-run-after-quit
2695 (lambda (f)
2696 (anything-find-files-1 f))
2697 (anything-aif (get-buffer (anything-get-selection))
2698 (or (buffer-file-name it)
2699 (car (rassoc it dired-buffers))
2700 (and (with-current-buffer it
2701 (eq major-mode 'org-agenda-mode))
2702 org-directory
2703 (expand-file-name org-directory))
2704 default-directory)
2705 (let ((sel (anything-get-selection)))
2706 (if (file-exists-p sel)
2707 (expand-file-name sel)
2708 default-directory)))))
2710 ;;;; <File>
2713 ;;; File name history
2714 (defvar anything-c-source-file-name-history
2715 '((name . "File Name History")
2716 (candidates . file-name-history)
2717 (match anything-c-match-on-file-name
2718 anything-c-match-on-directory-name)
2719 (type . file)))
2720 ;; (anything 'anything-c-source-file-name-history)
2722 ;;; Files in current dir
2725 (defvar anything-c-source-files-in-current-dir
2726 '((name . "Files from Current Directory")
2727 (candidates . (lambda ()
2728 (with-current-buffer anything-current-buffer
2729 (directory-files (anything-c-current-directory)))))
2730 ;; volatile is not needed, I think.
2731 (type . file)))
2732 ;; (anything 'anything-c-source-files-in-current-dir)
2734 (defun anything-c-highlight-files (files)
2735 (loop for i in files
2736 if (file-directory-p i)
2737 collect (propertize (file-name-nondirectory i)
2738 'face 'anything-ff-directory
2739 'help-echo (expand-file-name i))
2740 else
2741 collect (propertize (file-name-nondirectory i)
2742 'face 'anything-ff-file
2743 'help-echo (expand-file-name i))))
2745 (defvar anything-c-source-files-in-current-dir+
2746 '((name . "Files from Current Directory")
2747 (candidates . (lambda ()
2748 (with-current-buffer anything-current-buffer
2749 (directory-files (anything-c-current-directory) t))))
2750 (candidate-transformer anything-c-highlight-files)
2751 ;; volatile is not needed, I think.
2752 (type . file)))
2753 ;; (anything 'anything-c-source-files-in-current-dir+)
2755 ;;; Anything-find-files - The anything files browser.
2758 ;; Internal.
2759 (defvar anything-c-find-files-doc-header " (`C-l': Go to precedent level)"
2760 "*The doc that is inserted in the Name header of a find-files or dired source.")
2761 (defvar anything-ff-auto-update-flag anything-ff-auto-update-initial-value
2762 "Internal, flag to turn on/off auto-update in `anything-find-files'.
2763 Don't set it directly, use instead `anything-ff-auto-update-initial-value'.")
2764 (defvar anything-ff-last-expanded nil
2765 "Store last expanded directory or file.")
2766 (defvar anything-ff-default-directory nil)
2767 (defvar anything-ff-history nil)
2768 (defvar anything-ff-cand-to-mark nil)
2771 (defvar anything-c-source-find-files
2772 `((name . "Find Files")
2773 (header-name . (lambda (name)
2774 (concat name anything-c-find-files-doc-header)))
2775 ;; It is needed for filenames with capital letters
2776 (disable-shortcuts)
2777 (init . (lambda ()
2778 (setq anything-ff-auto-update-flag anything-ff-auto-update-initial-value)))
2779 (candidates . anything-find-files-get-candidates)
2780 (filtered-candidate-transformer anything-c-find-files-transformer)
2781 (image-action1 . anything-ff-rotate-image-left)
2782 (image-action2 . anything-ff-rotate-image-right)
2783 (properties-action . anything-ff-properties)
2784 (toggle-auto-update . anything-ff-toggle-auto-update)
2785 (kill-buffer-fname . anything-ff-kill-buffer-fname)
2786 (persistent-action . anything-find-files-persistent-action)
2787 (persistent-help . "Hit1 Expand Candidate, Hit2 or (C-u) Find file")
2788 (mode-line . anything-ff-mode-line-string)
2789 (volatile)
2790 (candidate-number-limit . 9999)
2791 (action-transformer . anything-find-files-action-transformer)
2792 (action
2793 . ,(delq
2795 `(("Find File" . anything-c-find-file-or-marked)
2796 ("Find file in Dired" . anything-c-point-file-in-dired)
2797 ,(and (locate-library "elscreen")
2798 '("Find file in Elscreen" . anything-elscreen-find-file))
2799 ,(and (locate-library "popwin")
2800 '("Find file in popup window" . popwin:find-file))
2801 ("Complete at point `M-tab'"
2802 . anything-c-insert-file-name-completion-at-point)
2803 ("Open file externally `C-c C-x, C-u to choose'"
2804 . anything-c-open-file-externally)
2805 ("Grep File(s) `M-g s, C-u Recurse'" . anything-find-files-grep)
2806 ("Zgrep File(s) `M-g z, C-u Recurse'" . anything-ff-zgrep)
2807 ("Switch to Eshell `M-e'" . anything-ff-switch-to-eshell)
2808 ("Etags `M-., C-u tap, C-u C-u reload tag file'" . anything-ff-etags-select)
2809 ("Eshell command on file(s) `M-!, C-u run on all marked at once.'"
2810 . anything-find-files-eshell-command-on-file)
2811 ("Find file as root" . anything-find-file-as-root)
2812 ("Find file in hex dump" . hexl-find-file)
2813 ("Ediff File `C-='" . anything-find-files-ediff-files)
2814 ("Ediff Merge File `C-c ='" . anything-find-files-ediff-merge-files)
2815 ("Delete File(s) `M-D'" . anything-delete-marked-files)
2816 ("Copy file(s) `M-C, C-u to follow'" . anything-find-files-copy)
2817 ("Copy file(s) Async" . anything-ff-copy-async)
2818 ("Rename file(s) `M-R, C-u to follow'" . anything-find-files-rename)
2819 ("Serial rename files" . anything-ff-serial-rename)
2820 ("Serial rename by symlinking files" . anything-ff-serial-rename-by-symlink)
2821 ("Serial rename by copying files" . anything-ff-serial-rename-by-copying)
2822 ("Symlink files(s) `M-S, C-u to follow'" . anything-find-files-symlink)
2823 ("Relsymlink file(s) `C-u to follow'" . anything-find-files-relsymlink)
2824 ("Hardlink file(s) `C-u to follow'" . anything-find-files-hardlink)
2825 ("Find file other window `C-o'" . find-file-other-window)
2826 ("Switch to history `M-p'" . anything-find-files-switch-to-hist)
2827 ("Find file other frame `C-c C-o'" . find-file-other-frame)
2828 ("Print File `C-c p'" . anything-ff-print))))))
2829 ;; (anything 'anything-c-source-find-files)
2831 (defun anything-find-files-set-prompt-for-action (prompt files)
2832 "Set prompt for action in `anything-find-files'."
2833 (let ((len (length files)))
2834 (if (> len 1)
2835 (format "%s * %d Files to: " prompt len)
2836 (format "%s %s to: " prompt (car files)))))
2838 (defun anything-dwim-target-directory ()
2839 "Return value of `default-directory' of buffer in other window.
2840 If there is only one window return the value ot `default-directory'
2841 for current buffer."
2842 (with-current-buffer anything-current-buffer
2843 (let ((num-windows (length (window-list))))
2844 (if (> num-windows 1)
2845 (save-window-excursion
2846 (other-window 1)
2847 default-directory)
2848 (car anything-ff-history)))))
2850 (defun anything-find-files-do-action (action)
2851 "Generic function for creating action from `anything-c-source-find-files'.
2852 ACTION must be an action supported by `anything-dired-action'."
2853 (let* ((ifiles (mapcar 'expand-file-name ; Allow modify '/foo/.' -> '/foo'
2854 (anything-marked-candidates)))
2855 (cand (anything-get-selection)) ; Target
2856 (prompt (anything-find-files-set-prompt-for-action
2857 (capitalize (symbol-name action)) ifiles))
2858 (parg anything-current-prefix-arg)
2859 (dest (anything-c-read-file-name
2860 prompt
2861 :preselect cand
2862 :initial-input (anything-dwim-target-directory)
2863 :history (anything-find-files-history :comp-read nil)))
2864 (win-conf (current-window-configuration)))
2865 (unwind-protect
2866 (let ((default-directory anything-ff-default-directory))
2867 (anything-dired-action
2868 dest :files ifiles :action action :follow parg))
2869 ;; Don't reset win-conf when following.
2870 (unless parg (set-window-configuration win-conf)))))
2872 (defun anything-find-files-copy (candidate)
2873 "Copy files from `anything-find-files'."
2874 (anything-find-files-do-action 'copy))
2876 (defun anything-find-files-rename (candidate)
2877 "Rename files from `anything-find-files'."
2878 (anything-find-files-do-action 'rename))
2880 (defun anything-find-files-symlink (candidate)
2881 "Symlink files from `anything-find-files'."
2882 (anything-find-files-do-action 'symlink))
2884 (defun anything-find-files-relsymlink (candidate)
2885 "Relsymlink files from `anything-find-files'."
2886 (anything-find-files-do-action 'relsymlink))
2888 (defun anything-find-files-hardlink (candidate)
2889 "Hardlink files from `anything-find-files'."
2890 (anything-find-files-do-action 'hardlink))
2892 (defun anything-find-files-byte-compile (candidate)
2893 "Byte compile elisp files from `anything-find-files'."
2894 (let ((files (anything-marked-candidates))
2895 (parg anything-current-prefix-arg))
2896 (loop for fname in files
2897 do (byte-compile-file fname parg))))
2899 (defun anything-find-files-load-files (candidate)
2900 "Load elisp files from `anything-find-files'."
2901 (let ((files (anything-marked-candidates)))
2902 (loop for fname in files
2903 do (load fname))))
2905 (defun anything-find-files-ediff-files (candidate)
2906 "Default action to ediff files in `anything-find-files'."
2907 (ediff-files
2908 candidate
2909 (anything-c-read-file-name
2910 (format "Ediff `%s' With File: " (file-name-nondirectory candidate)))))
2912 (defun anything-find-files-ediff-merge-files (candidate)
2913 "Default action to ediff merge files in `anything-find-files'."
2914 (ediff-merge-files
2915 candidate
2916 (anything-c-read-file-name
2917 (format "Ediff Merge `%s' With File: "
2918 (file-name-nondirectory candidate)))))
2920 (defun anything-find-files-grep (candidate)
2921 "Default action to grep files from `anything-find-files'."
2922 (anything-do-grep-1 (anything-marked-candidates)
2923 anything-current-prefix-arg))
2925 (defun anything-ff-zgrep (candidate)
2926 "Default action to zgrep files from `anything-find-files'."
2927 (let ((prefarg anything-current-prefix-arg)
2928 (ls (anything-marked-candidates)))
2929 (anything-ff-zgrep-1 ls prefarg)))
2931 (defun anything-ff-pdfgrep (candidate)
2932 "Default action to pdfgrep files from `anything-find-files'."
2933 (let ((cands (loop for file in (anything-marked-candidates)
2934 if (or (string= (file-name-extension file) "pdf")
2935 (string= (file-name-extension file) "PDF"))
2936 collect file))
2937 (anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init))
2938 (when cands
2939 (anything-do-pdfgrep-1 cands))))
2941 (defun anything-ff-etags-select (candidate)
2942 "Default action to jump to etags from `anything-find-files'."
2943 (when (get-buffer anything-action-buffer)
2944 (kill-buffer anything-action-buffer))
2945 (let ((default-directory anything-ff-default-directory))
2946 (anything-c-etags-select anything-current-prefix-arg)))
2948 (defun anything-find-files-switch-to-hist (candidate)
2949 "Switch to anything-find-files history."
2950 (anything-find-files t))
2952 ;;; Asynchronous copy of files.
2955 (defun anything-c-copy-files-async-1 (flist dest)
2956 "Copy a list of Files FLIST to DEST asynchronously.
2957 It use another emacs process to do the job.
2958 Communication with background emacs is done with temp file
2959 `anything-c-copy-files-async-log-file'."
2960 (start-file-process "emacs-batch" nil anything-c-copy-async-prefered-emacs
2961 "-Q" "--batch" "--eval"
2962 (format "(progn
2963 (require 'dired) (require 'cl)
2964 (let ((dired-recursive-copies 'always)
2965 failures success
2966 (ovw-count 0)
2967 (cpf-count 0))
2968 (dolist (f '%S)
2969 (condition-case err
2970 (let ((file-exists (file-exists-p
2971 (expand-file-name
2972 (file-name-nondirectory (directory-file-name f))
2973 (file-name-directory
2974 (file-name-as-directory \"%s\"))))))
2975 (dired-copy-file f \"%s\" t)
2976 (if file-exists
2977 (progn (push (cons \"Overwriting\" f) success)
2978 (incf ovw-count))
2979 (push (cons \"Copying\" f) success)
2980 (incf cpf-count)))
2981 (file-error
2982 (push (dired-make-relative
2983 (expand-file-name
2984 (file-name-nondirectory (directory-file-name f))
2985 (file-name-directory \"%s\")))
2986 failures))))
2987 (with-current-buffer (find-file-noselect \"%s\")
2988 (erase-buffer)
2989 (when failures
2990 (dolist (fail (reverse failures))
2991 (insert (concat \"Failed to copy \" fail \"\n\"))))
2992 (when success
2993 (loop for (a . s) in (reverse success) do
2994 (insert (concat a \" \" s \" to %s done\n\"))))
2995 (and (/= cpf-count 0) (insert (concat (int-to-string cpf-count) \" File(s) Copied\n\")))
2996 (and (/= ovw-count 0) (insert (concat (int-to-string ovw-count) \" File(s) Overwrited\n\")))
2997 (and failures (insert (concat (int-to-string (length failures)) \" File(s) Failed to copy\n\")))
2998 (save-buffer))))"
2999 flist dest dest dest anything-c-copy-files-async-log-file dest)))
3001 (defun anything-c-copy-async-with-log (flist dest)
3002 "Copy file list FLIST to DEST showing log.
3003 Log is send to `anything-c-copy-files-async-log-file'.
3004 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3005 (declare (special auto-revert-interval))
3006 (pop-to-buffer (find-file-noselect anything-c-copy-files-async-log-file))
3007 (set (make-local-variable 'auto-revert-interval) 1)
3008 (erase-buffer)
3009 (insert "Wait copying files...\n")
3010 (sit-for 0.5) (save-buffer)
3011 (goto-char (point-max))
3012 (auto-revert-mode 1)
3013 (anything-c-copy-files-async-1 flist dest))
3015 (defun anything-ff-copy-async (candidate)
3016 "Anything find files action to copy files async.
3017 Copying is done asynchronously with `anything-c-copy-files-async-1'."
3018 (let ((flist (anything-marked-candidates))
3019 (dest (anything-c-read-file-name
3020 "Copy File(s) async To: "
3021 :preselect candidate
3022 :initial-input (car anything-ff-history)
3023 :history (anything-find-files-history :comp-read nil))))
3024 (anything-c-copy-async-with-log flist dest)))
3026 (defun anything-c-copy-files-async ()
3027 "Preconfigured anything to copy file list FLIST to DEST asynchronously."
3028 (interactive)
3029 (let* ((flist (anything-c-read-file-name
3030 "Copy File async: "
3031 :marked-candidates t))
3032 (dest (anything-c-read-file-name
3033 "Copy File async To: "
3034 :preselect (car flist)
3035 :initial-input (car anything-ff-history)
3036 :history (anything-find-files-history :comp-read nil))))
3037 (anything-c-copy-async-with-log flist dest)))
3039 (defvar eshell-command-aliases-list nil)
3040 (defun anything-find-files-eshell-command-on-file-1 (candidate &optional map)
3041 "Run `eshell-command' on CANDIDATE or marked candidates possibly with an eshell alias.
3043 Basename of CANDIDATE can be a wild-card.
3044 If MAP is given run `eshell-command' on all marked files at once,
3045 Otherwise, run `eshell-command' on each marked files.
3047 If `eshell' or `eshell-command' have not been run once, or if you have no eshell aliases
3048 `eshell-command-aliases-list' will not be loaded first time you use this."
3049 (when (or eshell-command-aliases-list
3050 (y-or-n-p "Eshell is not loaded, run eshell-command without alias anyway? "))
3051 (and eshell-command-aliases-list (eshell-read-aliases-list))
3052 (let* ((cand-list (anything-marked-candidates))
3053 (default-directory (or anything-ff-default-directory
3054 ;; If candidate is an url *-ff-default-directory is nil
3055 ;; so keep value of default-directory.
3056 default-directory))
3057 (command (anything-comp-read
3058 "Command: "
3059 (loop for (a . c) in eshell-command-aliases-list
3060 when (string-match "\\(\\$1\\|\\$\\*\\)$" (car c))
3061 collect (propertize a 'help-echo (car c)) into ls
3062 finally return (sort ls 'string<))))
3063 (com-value (car (assoc-default command eshell-command-aliases-list))))
3064 (if (and (or map (and com-value (string-match "\\$\\*$" com-value)))
3065 (> (length cand-list) 1))
3066 ;; Run eshell-command with ALL marked files as arguments.
3067 (let ((mapfiles (mapconcat 'shell-quote-argument cand-list " ")))
3068 (eshell-command (format "%s %s" command mapfiles)))
3069 ;; Run eshell-command on EACH marked files.
3070 (loop
3071 for i in cand-list
3072 for bn = (anything-c-basename i)
3073 for files = (if (and bn (string-match "^\*" bn))
3074 ;; Assume if fname is a wildcard
3075 ;; cand-list have a length of 1.
3076 (mapconcat
3077 'shell-quote-argument
3078 (file-expand-wildcards i t) " ")
3079 (format "'%s'" i))
3080 for com = (if (string-match "'%s'\\|\"%s\"\\|%s" command)
3081 ;; This allow to enter other args AFTER filename
3082 ;; i.e <command %s some_more_args>
3083 (format command files)
3084 (format "%s %s" command files))
3085 do (eshell-command com))))))
3087 (defun anything-find-files-eshell-command-on-file (candidate)
3088 "Run `eshell-command' on CANDIDATE or marked candidates.
3089 See `anything-find-files-eshell-command-on-file-1' for more info."
3090 (anything-find-files-eshell-command-on-file-1
3091 candidate anything-current-prefix-arg))
3093 (defun anything-ff-switch-to-eshell (candidate)
3094 "Switch to eshell and cd to `anything-ff-default-directory'."
3095 (flet ((cd-eshell ()
3096 (goto-char (point-max))
3097 (insert
3098 (format "cd '%s'" anything-ff-default-directory))
3099 (eshell-send-input)))
3100 (if (get-buffer "*eshell*")
3101 (progn
3102 (anything-c-switch-to-buffer "*eshell*")
3103 (cd-eshell))
3104 (call-interactively 'eshell)
3105 (cd-eshell))))
3107 (defun anything-ff-serial-rename-action (method)
3108 "Rename all marked files to `anything-ff-default-directory' with METHOD.
3109 See `anything-ff-serial-rename-1'."
3110 (let ((cands (anything-marked-candidates))
3111 (name (read-string "NewName: "))
3112 (start (read-number "StartAtNumber: "))
3113 (dir (expand-file-name
3114 (anything-c-read-file-name
3115 "Serial Rename to directory: " :initial-input
3116 (expand-file-name anything-ff-default-directory)))))
3117 (when (y-or-n-p (format "Serial Rename %s *files to `%s' with prefix `%s'? "
3118 (length cands) dir name))
3119 (anything-ff-serial-rename-1 dir cands name start :method method)
3120 (anything-find-files-1 dir))))
3122 (defun anything-ff-member-directory-p (file directory)
3123 (let ((dir-file (expand-file-name (file-name-as-directory (file-name-directory file))))
3124 (cur-dir (expand-file-name (file-name-as-directory directory))))
3125 (string= dir-file cur-dir)))
3127 (defun* anything-ff-serial-rename-1
3128 (directory collection new-name start-at-num &key (method 'rename))
3129 "rename files in COLLECTION to DIRECTORY with the prefix name NEW-NAME.
3130 Rename start at number START-AT-NUM - ex: prefixname-01.jpg.
3131 METHOD can be one of rename, copy or symlink.
3132 Files will be renamed if they are files of current directory, otherwise they
3133 will be treated with METHOD.
3134 Default METHOD is rename."
3135 ;; Maybe remove directories selected by error in collection.
3136 (setq collection (remove-if 'file-directory-p collection))
3137 (flet ((symlink-file (file dest)
3138 (let ((flist (list file)))
3139 (anything-dired-action
3140 dest :action 'symlink :files flist))))
3142 (let* ((tmp-dir (file-name-as-directory
3143 (concat (file-name-as-directory directory)
3144 (symbol-name (gensym "tmp")))))
3145 (fn (case method
3146 (copy 'copy-file)
3147 (symlink 'symlink-file)
3148 (rename 'rename-file)
3149 (t (error "Error: Unknow method %s" method)))))
3150 (make-directory tmp-dir)
3151 (loop for i in collection
3152 for count from start-at-num
3153 for fnum = (if (< count 10) "0%s" "%s")
3154 for nname = (concat tmp-dir new-name (format fnum count)
3155 (file-name-extension i 'dot))
3156 do (if (anything-ff-member-directory-p i directory)
3157 (rename-file i nname)
3158 (funcall fn i nname)))
3159 (loop with dirlist = (directory-files
3160 tmp-dir t directory-files-no-dot-files-regexp)
3161 for f in dirlist do
3162 (if (file-symlink-p f)
3163 (symlink-file (file-truename f)
3164 (concat (file-name-as-directory directory)
3165 (anything-c-basename f)))
3166 (rename-file f directory)))
3167 (delete-directory tmp-dir t))))
3169 (defun anything-ff-serial-rename (candidate)
3170 "Serial rename all marked files to `anything-ff-default-directory'.
3171 Rename only file of current directory, and symlink files coming from
3172 other directories.
3173 See `anything-ff-serial-rename-1'."
3174 (anything-ff-serial-rename-action 'rename))
3176 (defun anything-ff-serial-rename-by-symlink (candidate)
3177 "Serial rename all marked files to `anything-ff-default-directory'.
3178 Rename only file of current directory, and symlink files coming from
3179 other directories.
3180 See `anything-ff-serial-rename-1'."
3181 (anything-ff-serial-rename-action 'symlink))
3183 (defun anything-ff-serial-rename-by-copying (candidate)
3184 "Serial rename all marked files to `anything-ff-default-directory'.
3185 Rename only file of current directory, and copy files coming from
3186 other directories.
3187 See `anything-ff-serial-rename-1'."
3188 (anything-ff-serial-rename-action 'copy))
3190 (defun anything-c-quit-and-execute-action (action)
3191 "Quit current anything session and execute ACTION."
3192 (setq anything-saved-action action)
3193 (anything-exit-minibuffer))
3195 (defun anything-ff-toggle-auto-update (candidate)
3196 (setq anything-ff-auto-update-flag (not anything-ff-auto-update-flag))
3197 (message "[Auto expansion %s]"
3198 (if anything-ff-auto-update-flag "enabled" "disabled")))
3200 ;;;###autoload
3201 (defun anything-ff-run-toggle-auto-update ()
3202 (interactive)
3203 (anything-execute-persistent-action 'toggle-auto-update))
3205 ;;;###autoload
3206 (defun anything-ff-run-switch-to-history ()
3207 "Run Switch to history action from `anything-c-source-find-files'."
3208 (interactive)
3209 (anything-c-quit-and-execute-action 'anything-find-files-switch-to-hist))
3211 ;;;###autoload
3212 (defun anything-ff-run-grep ()
3213 "Run Grep action from `anything-c-source-find-files'."
3214 (interactive)
3215 (anything-c-quit-and-execute-action 'anything-find-files-grep))
3217 ;;;###autoload
3218 (defun anything-ff-run-pdfgrep ()
3219 "Run Pdfgrep action from `anything-c-source-find-files'."
3220 (interactive)
3221 (anything-c-quit-and-execute-action 'anything-ff-pdfgrep))
3223 ;;;###autoload
3224 (defun anything-ff-run-zgrep ()
3225 "Run Grep action from `anything-c-source-find-files'."
3226 (interactive)
3227 (anything-c-quit-and-execute-action 'anything-ff-zgrep))
3229 ;;;###autoload
3230 (defun anything-ff-run-copy-file ()
3231 "Run Copy file action from `anything-c-source-find-files'."
3232 (interactive)
3233 (anything-c-quit-and-execute-action 'anything-find-files-copy))
3235 ;;;###autoload
3236 (defun anything-ff-run-rename-file ()
3237 "Run Rename file action from `anything-c-source-find-files'."
3238 (interactive)
3239 (anything-c-quit-and-execute-action 'anything-find-files-rename))
3241 ;;;###autoload
3242 (defun anything-ff-run-byte-compile-file ()
3243 "Run Byte compile file action from `anything-c-source-find-files'."
3244 (interactive)
3245 (anything-c-quit-and-execute-action 'anything-find-files-byte-compile))
3247 ;;;###autoload
3248 (defun anything-ff-run-load-file ()
3249 "Run Load file action from `anything-c-source-find-files'."
3250 (interactive)
3251 (anything-c-quit-and-execute-action 'anything-find-files-load-files))
3253 ;;;###autoload
3254 (defun anything-ff-run-eshell-command-on-file ()
3255 "Run eshell command on file action from `anything-c-source-find-files'."
3256 (interactive)
3257 (anything-c-quit-and-execute-action 'anything-find-files-eshell-command-on-file))
3259 ;;;###autoload
3260 (defun anything-ff-run-ediff-file ()
3261 "Run Ediff file action from `anything-c-source-find-files'."
3262 (interactive)
3263 (anything-c-quit-and-execute-action 'anything-find-files-ediff-files))
3265 ;;;###autoload
3266 (defun anything-ff-run-ediff-merge-file ()
3267 "Run Ediff merge file action from `anything-c-source-find-files'."
3268 (interactive)
3269 (anything-c-quit-and-execute-action 'anything-find-files-ediff-merge-files))
3271 ;;;###autoload
3272 (defun anything-ff-run-symlink-file ()
3273 "Run Symlink file action from `anything-c-source-find-files'."
3274 (interactive)
3275 (anything-c-quit-and-execute-action 'anything-find-files-symlink))
3277 ;;;###autoload
3278 (defun anything-ff-run-delete-file ()
3279 "Run Delete file action from `anything-c-source-find-files'."
3280 (interactive)
3281 (anything-c-quit-and-execute-action 'anything-delete-marked-files))
3283 ;;;###autoload
3284 (defun anything-ff-run-complete-fn-at-point ()
3285 "Run complete file name action from `anything-c-source-find-files'."
3286 (interactive)
3287 (anything-c-quit-and-execute-action
3288 'anything-c-insert-file-name-completion-at-point))
3290 ;;;###autoload
3291 (defun anything-ff-run-switch-to-eshell ()
3292 "Run switch to eshell action from `anything-c-source-find-files'."
3293 (interactive)
3294 (anything-c-quit-and-execute-action 'anything-ff-switch-to-eshell))
3296 ;;;###autoload
3297 (defun anything-ff-run-switch-other-window ()
3298 "Run switch to other window action from `anything-c-source-find-files'."
3299 (interactive)
3300 (anything-c-quit-and-execute-action 'find-file-other-window))
3302 ;;;###autoload
3303 (defun anything-ff-run-switch-other-frame ()
3304 "Run switch to other frame action from `anything-c-source-find-files'."
3305 (interactive)
3306 (anything-c-quit-and-execute-action 'find-file-other-frame))
3308 ;;;###autoload
3309 (defun anything-ff-run-open-file-externally ()
3310 "Run open file externally command action from `anything-c-source-find-files'."
3311 (interactive)
3312 (anything-c-quit-and-execute-action 'anything-c-open-file-externally))
3314 ;;;###autoload
3315 (defun anything-ff-run-gnus-attach-files ()
3316 "Run gnus attach files command action from `anything-c-source-find-files'."
3317 (interactive)
3318 (anything-c-quit-and-execute-action 'anything-ff-gnus-attach-files))
3320 ;;;###autoload
3321 (defun anything-ff-run-etags ()
3322 "Run Etags command action from `anything-c-source-find-files'."
3323 (interactive)
3324 (anything-c-quit-and-execute-action 'anything-ff-etags-select))
3326 (defun anything-ff-print (candidate)
3327 "Print marked files.
3328 Uses the shell command coming from variables `lpr-command' and
3329 `lpr-switches' as default.
3330 Same as `dired-do-print' but for anything."
3331 (let* ((file-list (anything-marked-candidates))
3332 (command (read-string
3333 "Print %s with: "
3334 (mapconcat 'identity
3335 (cons lpr-command
3336 (if (stringp lpr-switches)
3337 (list lpr-switches)
3338 lpr-switches))
3339 " ")))
3340 (file-args (mapconcat #'(lambda (x)
3341 (format "'%s'" x))
3342 file-list " "))
3343 (cmd-line (concat command " " file-args)))
3344 (start-process-shell-command "anything-print" nil cmd-line)))
3346 ;;;###autoload
3347 (defun anything-ff-run-print-file ()
3348 "Run Print file action from `anything-c-source-find-files'."
3349 (interactive)
3350 (anything-c-quit-and-execute-action 'anything-ff-print))
3352 (defun* anything-reduce-file-name (fname level &key unix-close expand)
3353 "Reduce FNAME by LEVEL from end or beginning depending LEVEL value.
3354 If LEVEL is positive reduce from end else from beginning.
3355 If UNIX-CLOSE is non--nil close filename with /.
3356 If EXPAND is non--nil expand-file-name."
3357 (let* ((exp-fname (expand-file-name fname))
3358 (fname-list (split-string (if (or (string= fname "~/") expand)
3359 exp-fname fname) "/" t))
3360 (len (length fname-list))
3361 (pop-list (if (< level 0)
3362 (subseq fname-list (* level -1))
3363 (subseq fname-list 0 (- len level))))
3364 (result (mapconcat 'identity pop-list "/"))
3365 (empty (string= result "")))
3366 (when unix-close (setq result (concat result "/")))
3367 (if (string-match "^~" result)
3368 (if (string= result "~/") "~/" result)
3369 (if (< level 0)
3370 (if empty "../" (concat "../" result))
3371 (cond ((eq system-type 'windows-nt)
3372 (if empty "c:/" result))
3373 (empty "/")
3375 (concat "/" result)))))))
3377 (defun anything-file-completion-source-p ()
3378 "Test if current source is a dired or find-files source."
3379 (let ((ff-sources '("Find Files" "Copy Files"
3380 "Read File Name History"
3381 "Rename Files" "Symlink Files"
3382 "Hardlink Files" "Write File"
3383 "Insert File" "Read file name"))
3384 (cur-source (cdr (assoc 'name (anything-get-current-source)))))
3385 (loop for i in ff-sources thereis (string= cur-source i))))
3387 (defun anything-find-files-down-one-level (arg)
3388 "Go down one level like unix command `cd ..'.
3389 If prefix numeric arg is given go ARG level down."
3390 (interactive "p")
3391 (with-anything-window
3392 (setq anything-follow-mode nil))
3393 ;; When going to precedent level we want to be at the line
3394 ;; corresponding to actual directory, so store this info
3395 ;; in `anything-ff-last-expanded'.
3396 (if (and (not (file-directory-p anything-pattern))
3397 (file-exists-p anything-pattern))
3398 (setq anything-ff-last-expanded anything-pattern)
3399 (setq anything-ff-last-expanded anything-ff-default-directory))
3400 (when (anything-file-completion-source-p)
3401 (let ((new-pattern (anything-reduce-file-name anything-pattern arg
3402 :unix-close t :expand t)))
3403 (with-selected-window (minibuffer-window)
3404 (delete-minibuffer-contents)
3405 (insert new-pattern)))))
3407 (defun anything-ff-retrieve-last-expanded ()
3408 "Move overlay to last visited directory `anything-ff-last-expanded'.
3409 This happen after using `anything-find-files-down-one-level',
3410 or hitting C-z on \"..\"."
3411 (when (and anything-ff-last-expanded
3412 (anything-file-completion-source-p))
3413 (let ((dirname (directory-file-name anything-ff-last-expanded)))
3414 (with-anything-window
3415 (when (or (re-search-forward (concat dirname "$") nil t)
3416 (re-search-forward
3417 (concat anything-ff-last-expanded "$") nil t))
3418 (forward-line 0)
3419 (anything-mark-current-line)))
3420 (setq anything-ff-last-expanded nil))))
3421 (add-hook 'anything-after-update-hook 'anything-ff-retrieve-last-expanded)
3423 ;; Auto-update: anything-find-files auto expansion of directories.
3424 ;; Internal
3425 (defun anything-ff-update-when-only-one-matched ()
3426 "Expand to directory when sole completion.
3427 When only one candidate is remaining and it is a directory,
3428 expand to this directory."
3429 (let ((history-p (string= (assoc-default
3430 'name (anything-get-current-source))
3431 "Read File Name History"))
3432 (completed-p (string= (file-name-as-directory anything-pattern)
3433 anything-ff-default-directory)))
3434 (when (and anything-ff-auto-update-flag
3435 (or (and (anything-file-completion-source-p)
3436 (<= (anything-approximate-candidate-number) 2)
3437 (>= (length (anything-c-basename anything-pattern)) 2))
3438 completed-p)
3439 (not history-p))
3440 (with-anything-window
3441 (and (not completed-p) (anything-next-line))
3442 (let ((cur-cand (anything-get-selection)))
3443 (when (file-directory-p cur-cand)
3444 (if (not (string-match "^.*[.]\\{1,2\\}$" cur-cand))
3445 ;; If after going to next line the candidate is not "." or ".."
3446 ;; we assume candidate is a new directory to expand, so do it.
3447 (anything-set-pattern (file-name-as-directory cur-cand))
3448 ;; The candidate is one of "." or ".." (it should be "..").
3449 ;; that mean we have entered the last letter of the directory name
3450 ;; in prompt, so expansion is already done, just add the "/" at end
3451 ;; of name unless anything-pattern ends with "."
3452 (unless (string-match "^.*[.]\\{1\\}$" anything-pattern)
3453 (anything-set-pattern (file-name-as-directory anything-pattern))))
3454 (anything-check-minibuffer-input-1)))))))
3455 (add-hook 'anything-after-update-hook 'anything-ff-update-when-only-one-matched)
3457 ;; Allow expanding to home directory or root
3458 ;; when entering respectively "~/" or "//" at end of pattern.
3459 ;; e.g /home/thierry/labo/anything-config-qp/~/
3460 ;; will expand to "~/"
3461 ;; and /home/thierry/labo/anything-config-qp//
3462 ;; will expand to "/"
3463 (defun anything-ff-auto-expand-to-home-or-root ()
3464 (when (and (anything-file-completion-source-p)
3465 (string-match ".*\\(/~/\\|/\\{2\\}\\)$" anything-pattern))
3466 (let ((match (match-string 1 anything-pattern)))
3467 (cond ((string= match "//")
3468 (if (eq system-type 'windows-nt)
3469 (setq anything-pattern "c:/")
3470 (setq anything-pattern "/")))
3471 ((string= match "/~/")
3472 (if (eq system-type 'windows-nt)
3473 (setq anything-pattern (replace-regexp-in-string
3474 "\\\\" "/" (getenv "HOME")))
3475 (setq anything-pattern "~/")))))
3476 (setq anything-ff-default-directory anything-pattern)
3477 (with-current-buffer (window-buffer (minibuffer-window))
3478 (delete-minibuffer-contents)
3479 (insert anything-pattern))))
3480 (add-hook 'anything-after-update-hook 'anything-ff-auto-expand-to-home-or-root)
3482 (defun anything-c-point-file-in-dired (file)
3483 "Put point on filename FILE in dired buffer."
3484 (dired (file-name-directory file))
3485 (dired-goto-file file))
3487 (defun anything-create-tramp-name (fname)
3488 "Build filename for `anything-pattern' like /su:: or /sudo::."
3489 (apply #'tramp-make-tramp-file-name
3490 (loop with v = (tramp-dissect-file-name fname)
3491 for i across v collect i)))
3493 (defun anything-ff-set-pattern (pattern)
3494 "Handle tramp filenames in `anything-pattern'."
3495 (let ((methods (mapcar 'car tramp-methods))
3496 (reg "\\`/\\([^[/:]+\\|[^/]+]\\):.*:")
3497 cur-method tramp-name)
3498 (cond ((string= pattern "") "")
3499 ((string-match ".*\\(~//\\|//\\)$" pattern)
3500 (if (eq system-type 'windows-nt) "c:/" "/"))
3501 ((string-match "^~\\|.*/~/$" pattern)
3502 (let* ((home (getenv "HOME"))
3503 (replace (if (eq system-type 'windows-nt)
3504 (replace-regexp-in-string
3505 "\\\\" "/" home)
3506 home)))
3507 (replace-match replace nil t pattern)))
3508 ;; Match "/method:maybe_hostname:"
3509 ((and (string-match reg pattern)
3510 (setq cur-method (match-string 1 pattern))
3511 (member cur-method methods))
3512 (setq tramp-name (anything-create-tramp-name
3513 (match-string 0 pattern)))
3514 (replace-match tramp-name nil t pattern))
3515 ;; Match "/hostname:"
3516 ((and (string-match tramp-file-name-regexp pattern)
3517 (setq cur-method (match-string 1 pattern))
3518 (and cur-method (not (member cur-method methods))))
3519 (setq tramp-name (anything-create-tramp-name
3520 (match-string 0 pattern)))
3521 (replace-match tramp-name nil t pattern))
3522 ;; Match "/method:" in this case don't try to connect.
3523 ((and (not (string-match reg pattern))
3524 (string-match tramp-file-name-regexp pattern)
3525 (member (match-string 1 pattern) methods))
3526 "Invalid tramp file name") ; Write in anything-buffer.
3527 ;; PATTERN is a directory, end it with "/".
3528 ;; This will make PATTERN not ending yet with "/"
3529 ;; candidate for `anything-ff-default-directory',
3530 ;; allowing `anything-ff-retrieve-last-expanded' to retrieve it
3531 ;; when descending level.
3532 ((file-directory-p pattern)
3533 (file-name-as-directory pattern))
3534 ;; Return PATTERN unchanged.
3535 (t pattern))))
3538 (defun anything-find-files-get-candidates ()
3539 "Create candidate list for `anything-c-source-find-files'."
3540 (let* ((path (anything-ff-set-pattern anything-pattern))
3541 (path-name-dir (if (file-directory-p path)
3542 (file-name-as-directory path)
3543 (file-name-directory path)))
3544 (tramp-verbose anything-tramp-verbose)) ; No tramp message when 0.
3545 (set-text-properties 0 (length path) nil path)
3546 (setq anything-pattern (anything-ff-transform-fname-for-completion path))
3547 (setq anything-ff-default-directory
3548 (if (string= anything-pattern "")
3549 (if (eq system-type 'windows-nt) "c:/" "/")
3550 (unless (string-match ffap-url-regexp path)
3551 path-name-dir)))
3552 (cond ((or (string= path "Invalid tramp file name")
3553 (file-regular-p path)
3554 (and (not (file-exists-p path)) (string-match "/$" path))
3555 (and ffap-url-regexp (string-match ffap-url-regexp path)))
3556 (list path))
3557 ((string= path "") (directory-files "/" t))
3558 ((and (file-directory-p path) (not (file-readable-p path)))
3559 (list (format "Opening directory: access denied, `%s'" path)))
3560 ((file-directory-p path) (directory-files path t))
3562 (append (list path) (directory-files path-name-dir t))))))
3564 (defun anything-ff-transform-fname-for-completion (fname)
3565 "Return FNAME with it's basename modified as a regexp.
3566 e.g foo => f.*o.*o .
3567 If basename contain one or more space or FNAME is a valid directory name
3568 return FNAME unchanged."
3569 (let ((bn (anything-c-basename fname)))
3570 (if (or (not anything-ff-smart-completion)
3571 (string-match "\\s-" bn)
3572 (string-match "/$" fname) ; Allow mkdir.
3573 (file-directory-p fname))
3574 fname ; Fall back to match-plugin.
3575 (setq bn (if (> (length bn) 2) ; Normal completion on first 2 char.
3576 (mapconcat 'identity (split-string bn "" t) ".*") bn))
3577 (concat (file-name-directory fname) bn))))
3579 (defun anything-ff-save-history ()
3580 "Store the last value of `anything-ff-default-directory' \
3581 in `anything-ff-history'."
3582 (when (and anything-ff-default-directory
3583 (anything-file-completion-source-p))
3584 (push anything-ff-default-directory anything-ff-history)))
3585 (add-hook 'anything-cleanup-hook 'anything-ff-save-history)
3587 (defun anything-ff-valid-symlink-p (file)
3588 (file-exists-p (file-truename file)))
3590 (defun anything-ff-properties (candidate)
3591 "Show file properties of CANDIDATE in a tooltip or message."
3592 (let ((type (anything-ff-attributes candidate :type t))
3593 (dired-line (anything-ff-attributes candidate :dired t :human-size t)))
3594 (if (window-system)
3595 (tooltip-show
3596 (concat
3597 (anything-c-basename candidate) ": \n"
3598 "Type: " type "\n"
3599 (when (string= type "symlink")
3600 (format "True name: '%s'\n"
3601 (cond ((string-match "^\.#" (anything-c-basename candidate))
3602 "Autosave symlink")
3603 ((anything-ff-valid-symlink-p candidate)
3604 (file-truename candidate))
3605 (t "Invalid Symlink"))))
3606 dired-line))
3607 (message dired-line) (sit-for 5))))
3609 ;;;###autoload
3610 (defun anything-ff-properties-persistent ()
3611 "Show properties without quitting anything."
3612 (interactive)
3613 (anything-execute-persistent-action 'properties-action))
3615 (defun anything-ff-kill-buffer-fname (candidate)
3616 (let* ((buf (get-file-buffer candidate))
3617 (buf-name (buffer-name buf)))
3618 (if buf
3619 (progn
3620 (kill-buffer buf) (message "Buffer `%s' killed" buf))
3621 (message "No buffer to kill"))))
3623 (defun anything-ff-kill-or-find-buffer-fname (candidate)
3624 "Find file CANDIDATE or kill it's buffer if it is visible.
3625 Never kill `anything-current-buffer'.
3626 Never kill buffer modified.
3627 This is called normally on third hit of \
3628 \\<anything-map>\\[anything-execute-persistent-action]
3629 in `anything-find-files-persistent-action'."
3630 (let* ((buf (get-file-buffer candidate))
3631 (buf-name (buffer-name buf)))
3632 (if (and buf (get-buffer-window buf)
3633 (not (eq buf (get-buffer anything-current-buffer)))
3634 (not (buffer-modified-p buf)))
3635 (progn
3636 (kill-buffer buf) (message "Buffer `%s' killed" buf-name))
3637 (find-file candidate))))
3639 ;;;###autoload
3640 (defun anything-ff-run-kill-buffer-persistent ()
3641 "Execute `anything-ff-kill-buffer-fname' whitout quitting."
3642 (interactive)
3643 (anything-execute-persistent-action 'kill-buffer-fname))
3645 (defun anything-ff-human-size (size)
3646 "Return a string showing SIZE of a file in human readable form.
3647 SIZE can be an integer or a float depending it's value.
3648 `file-attributes' will take care of that to avoid overflow error.
3649 KBSIZE if a floating point number, default value is 1024.0."
3650 (let ((M (cons "M" (/ size (expt anything-ff-default-kbsize 2))))
3651 (G (cons "G" (/ size (expt anything-ff-default-kbsize 3))))
3652 (K (cons "K" (/ size anything-ff-default-kbsize)))
3653 (B (cons "B" size)))
3654 (loop with result = B
3655 for (a . b) in
3656 (loop for (x . y) in (list M G K B)
3657 unless (< y 1) collect (cons x y))
3658 when (< b (cdr result)) do (setq result (cons a b))
3659 finally return (if (string= (car result) "B")
3660 (format "%s" size)
3661 (format "%.1f%s" (cdr result) (car result))))))
3663 (defun* anything-ff-attributes
3664 (file &key type links uid gid access-time modif-time
3665 status size mode gid-change inode device-num dired human-size)
3666 "Easy interface for `file-attributes'."
3667 (let ((all (destructuring-bind
3668 (type links uid gid access-time modif-time
3669 status size mode gid-change inode device-num)
3670 (file-attributes file 'string)
3671 (list :type type
3672 :links links
3673 :uid uid
3674 :gid gid
3675 :access-time access-time
3676 :modif-time modif-time
3677 :status status
3678 :size size
3679 :mode mode
3680 :gid-change gid-change
3681 :inode inode
3682 :device-num device-num))))
3683 (cond (type
3684 (let ((result (getf all :type)))
3685 (cond ((stringp result)
3686 "symlink")
3687 (result "directory")
3688 (t "file"))))
3689 (links (getf all :links))
3690 (uid (getf all :uid))
3691 (gid (getf all :gid))
3692 (access-time
3693 (format-time-string "%Y-%m-%d %R" (getf all :access-time)))
3694 (modif-time
3695 (format-time-string "%Y-%m-%d %R" (getf all :modif-time)))
3696 (status
3697 (format-time-string "%Y-%m-%d %R" (getf all :status)))
3698 (size (if human-size (anything-ff-human-size (getf all :size))
3699 (getf all :size)))
3700 (mode (getf all :mode))
3701 (gid-change (getf all :gid-change))
3702 (inode (getf all :inode))
3703 (device-num (getf all :device-num))
3704 (dired
3705 (concat
3706 (getf all :mode) " "
3707 (number-to-string (getf all :links)) " "
3708 (getf all :uid) ":"
3709 (getf all :gid) " "
3710 (if human-size (anything-ff-human-size (getf all :size))
3711 (int-to-string (getf all :size))) " "
3712 (format-time-string "%Y-%m-%d %R" (getf all :modif-time))))
3713 (t all))))
3716 (defun anything-c-prefix-filename (fname &optional image file-or-symlinkp)
3717 "Return fname FNAME prefixed with icon IMAGE."
3718 (let* ((img-name (and image (expand-file-name
3719 image anything-c-find-files-icons-directory)))
3720 (img (and image (create-image img-name)))
3721 (prefix-img (and image (propertize " " 'display img)))
3722 (prefix-new (propertize
3723 " " 'display
3724 (propertize "[?]" 'face 'anything-ff-prefix)))
3725 (prefix-url (propertize
3726 " " 'display
3727 (propertize "[@]" 'face 'anything-ff-prefix))))
3728 (cond ((or file-or-symlinkp
3729 (file-exists-p fname)
3730 (file-symlink-p fname))
3731 (if image (concat prefix-img fname) fname))
3732 ((string-match ffap-url-regexp fname) (concat prefix-url " " fname))
3733 (t (concat prefix-new " " fname)))))
3735 (defun anything-c-find-files-transformer (files sources)
3736 "Selector of transformer to use for `anything-c-source-find-files'."
3737 (if (and (string-match tramp-file-name-regexp anything-pattern)
3738 anything-ff-tramp-not-fancy)
3739 files
3740 (if (and (window-system) anything-c-find-files-show-icons)
3741 (anything-c-highlight-ffiles1 files sources)
3742 (anything-c-highlight-ffiles files sources))))
3744 (defun anything-c-highlight-ffiles (files sources)
3745 "Candidate transformer for `anything-c-source-find-files' without icons."
3746 (loop for i in files collect
3747 (cond ((and (stringp (car (file-attributes i)))
3748 (not (anything-ff-valid-symlink-p i))
3749 (not (string-match "^\.#" (anything-c-basename i))))
3750 (cons (anything-c-prefix-filename
3751 (propertize i 'face 'anything-ff-invalid-symlink) nil t)
3753 ((stringp (car (file-attributes i)))
3754 (cons (anything-c-prefix-filename
3755 (propertize i 'face 'anything-ff-symlink) nil t)
3757 ((eq t (car (file-attributes i)))
3758 (cons (anything-c-prefix-filename
3759 (propertize i 'face 'anything-ff-directory) nil t)
3761 ((file-executable-p i)
3762 (cons (anything-c-prefix-filename
3763 (propertize i 'face 'anything-ff-executable) nil t)
3766 (cons (anything-c-prefix-filename
3767 (propertize i 'face 'anything-ff-file))
3768 i)))))
3770 (defun anything-c-highlight-ffiles1 (files sources)
3771 "Candidate transformer for `anything-c-source-find-files' that show icons."
3772 (loop for i in files
3773 for af = (file-name-nondirectory i)
3774 collect (cond ( ;; Files.
3775 (eq nil (car (file-attributes i)))
3776 (let ((face (if (file-executable-p i)
3777 'anything-ff-executable
3778 'anything-ff-file)))
3779 (cons (anything-c-prefix-filename
3780 (propertize i 'face face) "leaf.xpm")
3781 i)))
3782 ( ;; Empty directories.
3783 (and (eq t (car (file-attributes i)))
3784 ;; Be sure to have permission to list content.
3785 (file-readable-p i)
3786 (eq 0 (length
3787 (directory-files
3788 i nil directory-files-no-dot-files-regexp t))))
3789 (cons (anything-c-prefix-filename
3790 (propertize
3791 i 'face 'anything-ff-directory)
3792 "empty.xpm")
3794 ( ;; Open directories.
3795 (and (eq t (car (file-attributes i))) (get-buffer af))
3796 (cons (anything-c-prefix-filename
3797 (propertize
3798 i 'face 'anything-ff-directory)
3799 "open.xpm")
3801 ( ;; Closed directories.
3802 (eq t (car (file-attributes i)))
3803 (cons (anything-c-prefix-filename
3804 (propertize
3805 i 'face 'anything-ff-directory)
3806 "close.xpm")
3808 ( ;; Open Symlinks directories.
3809 (and (stringp (car (file-attributes i)))
3810 (file-directory-p i) (get-buffer af))
3811 (cons (anything-c-prefix-filename
3812 (propertize i 'face 'anything-ff-symlink))
3814 ( ;; Closed Symlinks directories.
3815 (and (stringp (car (file-attributes i)))
3816 (file-directory-p i))
3817 (cons (anything-c-prefix-filename
3818 (propertize i 'face 'anything-ff-symlink))
3820 ( ;; Invalid Symlinks
3821 (and (stringp (car (file-attributes i)))
3822 (not (anything-ff-valid-symlink-p i))
3823 (not (string-match "^\.#" (anything-c-basename i))))
3824 (cons (anything-c-prefix-filename
3825 (propertize i 'face 'anything-ff-invalid-symlink)
3826 "leaf.xpm")
3828 ( ;; Files symlinks.
3829 (stringp (car (file-attributes i)))
3830 (cons (anything-c-prefix-filename
3831 (propertize i 'face 'anything-ff-symlink)
3832 "leaf.xpm")
3833 i)))))
3835 (defun anything-find-files-action-transformer (actions candidate)
3836 "Action transformer for `anything-c-source-find-files'."
3837 (cond ((with-current-buffer anything-current-buffer
3838 (eq major-mode 'message-mode))
3839 (append (subseq actions 0 4)
3840 '(("Gnus attach file(s)" . anything-ff-gnus-attach-files))
3841 (subseq actions 4)))
3842 ((string-match (image-file-name-regexp) candidate)
3843 (append (subseq actions 0 4)
3844 '(("Rotate image right `M-r'" . anything-ff-rotate-image-right)
3845 ("Rotate image left `M-l'" . anything-ff-rotate-image-left))
3846 (subseq actions 4)))
3847 ((string-match "\.el$" (anything-aif (anything-marked-candidates)
3848 (car it) candidate))
3849 (append (subseq actions 0 4)
3850 '(("Byte compile lisp file(s) `M-B, C-u to load'"
3851 . anything-find-files-byte-compile)
3852 ("Load File(s) `M-L'" . anything-find-files-load-files))
3853 (subseq actions 4)))
3854 ((and (string-match "\.html?$" candidate)
3855 (file-exists-p candidate))
3856 (append (subseq actions 0 4)
3857 '(("Browse url file" . browse-url-of-file))
3858 (subseq actions 5)))
3859 ((or (string= (file-name-extension candidate) "pdf")
3860 (string= (file-name-extension candidate) "PDF"))
3861 (append (subseq actions 0 4)
3862 '(("Pdfgrep File(s)" . anything-ff-pdfgrep))
3863 (subseq actions 5)))
3864 (t actions)))
3866 (defun anything-ff-gnus-attach-files (candidate)
3867 "Run `gnus-dired-attach' on `anything-marked-candidates' or CANDIDATE."
3868 (let ((flist (anything-marked-candidates)))
3869 (gnus-dired-attach flist)))
3871 (defun anything-ff-rotate-current-image1 (file &optional num-arg)
3872 "Rotate current image at NUM-ARG degrees.
3873 This is a destructive operation on FILE made by external tool mogrify."
3874 (declare (special image-dired-display-image-buffer))
3875 (setq file (file-truename file)) ; For symlinked images.
3876 ;; When FILE is not an image-file, do nothing.
3877 (when (string-match (image-file-name-regexp) file)
3878 (if (executable-find "mogrify")
3879 (progn
3880 (shell-command (format "mogrify -rotate %s %s" (or num-arg 90) file))
3881 (when (buffer-live-p image-dired-display-image-buffer)
3882 (kill-buffer image-dired-display-image-buffer))
3883 (image-dired-display-image file)
3884 (message nil)
3885 (display-buffer (get-buffer image-dired-display-image-buffer)))
3886 (error "mogrify not found"))))
3888 (defun anything-ff-rotate-image-left (candidate)
3889 "Rotate image file CANDIDATE left.
3890 This affect directly file CANDIDATE."
3891 (anything-ff-rotate-current-image1 candidate -90))
3893 (defun anything-ff-rotate-image-right (candidate)
3894 "Rotate image file CANDIDATE right.
3895 This affect directly file CANDIDATE."
3896 (anything-ff-rotate-current-image1 candidate))
3898 (defun anything-ff-rotate-left-persistent ()
3899 "Rotate image left without quitting anything."
3900 (interactive)
3901 (anything-execute-persistent-action 'image-action1))
3903 (defun anything-ff-rotate-right-persistent ()
3904 "Rotate image right without quitting anything."
3905 (interactive)
3906 (anything-execute-persistent-action 'image-action2))
3908 (defun anything-ff-exif-data (candidate)
3909 "Extract exif data from file CANDIDATE using `anything-ff-exif-data-program'."
3910 (if (and anything-ff-exif-data-program
3911 (executable-find anything-ff-exif-data-program))
3912 (shell-command-to-string (format "%s %s %s"
3913 anything-ff-exif-data-program
3914 anything-ff-exif-data-program-args
3915 candidate))
3916 (format "No program %s found to extract exif"
3917 anything-ff-exif-data-program)))
3919 (defun anything-find-files-persistent-action (candidate)
3920 "Open subtree CANDIDATE without quitting anything.
3921 If CANDIDATE is not a directory expand CANDIDATE filename.
3922 If CANDIDATE is alone, open file CANDIDATE filename.
3923 That's mean:
3924 First hit on C-z expand CANDIDATE second hit open file.
3925 If a prefix arg is given or `anything-follow-mode' is on open file."
3926 (let ((follow (buffer-local-value
3927 'anything-follow-mode
3928 (get-buffer-create anything-buffer)))
3929 (new-pattern (anything-get-selection))
3930 (num-lines-buf (with-current-buffer anything-buffer
3931 (count-lines (point-min) (point-max)))))
3932 (flet ((insert-in-minibuffer (fname)
3933 (with-selected-window (minibuffer-window)
3934 (unless follow
3935 (delete-minibuffer-contents)
3936 (set-text-properties 0 (length fname) nil fname)
3937 (insert fname)))))
3938 (cond (;; A symlink directory, expand it's truename.
3939 (and (file-directory-p candidate) (file-symlink-p candidate))
3940 (insert-in-minibuffer (file-name-as-directory
3941 (file-truename
3942 (expand-file-name candidate)))))
3943 ;; A directory, open it.
3944 ((file-directory-p candidate)
3945 (when (string= (anything-c-basename candidate) "..")
3946 (setq anything-ff-last-expanded anything-ff-default-directory))
3947 (insert-in-minibuffer (file-name-as-directory
3948 (expand-file-name candidate))))
3949 ;; A symlink file, expand to it's true name. (first hit)
3950 ((and (file-symlink-p candidate) (not current-prefix-arg) (not follow))
3951 (insert-in-minibuffer (file-truename candidate)))
3952 ;; A regular file, expand it, (first hit)
3953 ((and (>= num-lines-buf 3) (not current-prefix-arg) (not follow))
3954 (insert-in-minibuffer new-pattern))
3955 ;; An image file and it is the second hit on C-z,
3956 ;; show the file in `image-dired'.
3957 ((string-match (image-file-name-regexp) candidate)
3958 (when (buffer-live-p image-dired-display-image-buffer)
3959 (kill-buffer image-dired-display-image-buffer))
3960 (image-dired-display-image candidate)
3961 (message nil)
3962 (anything-c-switch-to-buffer image-dired-display-image-buffer)
3963 (with-current-buffer image-dired-display-image-buffer
3964 (let ((exif-data (anything-ff-exif-data candidate)))
3965 (image-dired-update-property 'help-echo exif-data))))
3966 ;; Allow browsing archive on avfs fs.
3967 ;; Assume volume is already mounted with mountavfs.
3968 ((and anything-ff-avfs-directory
3969 (string-match
3970 (regexp-quote (expand-file-name anything-ff-avfs-directory))
3971 (file-name-directory candidate))
3972 (anything-ff-file-compressed-p candidate))
3973 (insert-in-minibuffer (concat candidate "#")))
3974 ;; On second hit we open file.
3975 ;; On Third hit we kill it's buffer maybe.
3977 (anything-ff-kill-or-find-buffer-fname candidate))))))
3979 (defun anything-ff-file-compressed-p (candidate)
3980 "Whether CANDIDATE is a compressed file or not."
3981 (member (file-name-extension candidate)
3982 anything-ff-file-compressed-list))
3984 (defun anything-c-insert-file-name-completion-at-point (candidate)
3985 "Insert file name completion at point."
3986 (with-current-buffer anything-current-buffer
3987 (if buffer-read-only
3988 (error "Error: Buffer `%s' is read-only" (buffer-name))
3989 (let* ((end (point))
3990 (guess (substring-no-properties (thing-at-point 'filename)))
3991 (beg (- (point) (length guess)))
3992 (full-path-p (or (string-match-p (concat "^" (getenv "HOME")) guess)
3993 (string-match-p "^[^\~]" guess))))
3994 (set-text-properties 0 (length candidate) nil candidate)
3995 (if (and guess (not (string= guess ""))
3996 (string-match-p "^~\\|/.*" guess))
3997 (progn
3998 (delete-region beg end)
3999 (insert (if full-path-p
4000 (expand-file-name candidate)
4001 (abbreviate-file-name candidate))))
4002 (error "Aborting completion: No valid file name at point"))))))
4004 (defun* anything-find-files-history (&key (comp-read t))
4005 "The `anything-find-files' history.
4006 Show the first `anything-ff-history-max-length' elements of `anything-ff-history'
4007 in an `anything-comp-read'."
4008 (let ((history (when anything-ff-history
4009 (loop with dup for i in anything-ff-history
4010 ;; Remove duplicate and not existing files.
4011 ;; Keep remote files.
4012 unless (or (member i dup)
4013 (and (not (file-remote-p i))
4014 (not (file-exists-p i))))
4015 collect i into dup
4016 finally return dup)))) ; Remove dups.
4017 (when history
4018 (setq anything-ff-history
4019 (if (>= (length history) anything-ff-history-max-length)
4020 (subseq history 0 anything-ff-history-max-length)
4021 history))
4022 (if comp-read
4023 (anything-comp-read
4024 "Switch to Directory: "
4025 anything-ff-history
4026 :name "Anything Find Files History"
4027 :must-match t)
4028 anything-ff-history))))
4030 ;;;###autoload
4031 (defun anything-find-files (arg)
4032 "Preconfigured `anything' for anything implementation of `find-file'.
4033 Called with a prefix arg show history if some.
4034 Don't call it from programs, use `anything-find-files-1' instead.
4035 This is the starting point for nearly all actions you can do on files."
4036 (interactive "P")
4037 (let ((any-input (if (and arg anything-ff-history)
4038 (anything-find-files-history)
4039 (anything-find-files-initial-input))))
4040 (when (and (eq major-mode 'org-agenda-mode)
4041 org-directory
4042 (not any-input))
4043 (setq any-input (expand-file-name org-directory)))
4044 (set-text-properties 0 (length any-input) nil any-input)
4045 (if any-input
4046 (anything-find-files-1 any-input)
4047 (setq any-input (expand-file-name (anything-c-current-directory)))
4048 (anything-find-files-1 any-input (buffer-file-name (current-buffer))))))
4051 (defun anything-find-files-1 (fname &optional preselect)
4052 "Find FNAME with `anything' completion.
4053 Like `find-file' but with `anything' support.
4054 Use it for non--interactive calls of `anything-find-files'."
4055 (when (get-buffer anything-action-buffer)
4056 (kill-buffer anything-action-buffer))
4057 (let ((anything-mp-highlight-delay nil))
4058 (anything :sources 'anything-c-source-find-files
4059 :input fname
4060 :preselect preselect
4061 :keymap anything-find-files-map
4062 :prompt "Find Files or Url: "
4063 :buffer "*Anything Find Files*")))
4066 (defun anything-find-files-initial-input (&optional input)
4067 "Return INPUT if present, otherwise try to guess it."
4068 (or (and input (expand-file-name input))
4069 (anything-find-files-input
4070 (ffap-guesser)
4071 (thing-at-point 'filename))))
4073 (defun anything-find-files-input (fap tap)
4074 "Default input of `anything-find-files'."
4075 (let* ((def-dir (anything-c-current-directory))
4076 (lib (anything-find-library-at-point))
4077 (url (anything-ff-find-url-at-point))
4078 (file-p (and fap (not (string= fap ""))
4079 (file-exists-p fap)
4080 tap (not (string= tap ""))
4081 (file-exists-p
4082 (file-name-directory (expand-file-name tap def-dir))))))
4083 (cond (lib) ; e.g we are inside a require sexp.
4084 (url) ; String at point is an hyperlink.
4085 (file-p (expand-file-name tap def-dir))
4086 (t (and (not (string= fap "")) fap)))))
4088 (defun anything-c-current-directory ()
4089 "Return current-directory name at point.
4090 Useful in dired buffers when there is inserted subdirs."
4091 (if (eq major-mode 'dired-mode)
4092 (dired-current-directory)
4093 default-directory))
4095 (defun anything-ff-find-url-at-point ()
4096 "Try to find link to an url in text-property at point."
4097 (let* ((he (get-text-property (point) 'help-echo))
4098 (ov (overlays-at (point)))
4099 (ov-he (and ov (overlay-get
4100 (car (overlays-at (point))) 'help-echo)))
4101 (w3m-l (get-text-property (point) 'w3m-href-anchor))
4102 (nt-prop (get-text-property (point) 'nt-link)))
4103 ;; Org link.
4104 (when (and (stringp he) (string-match "^LINK: " he))
4105 (setq he (replace-match "" t t he)))
4106 (loop for i in (list he ov-he w3m-l nt-prop)
4107 thereis (and (stringp i) (string-match ffap-url-regexp i) i))))
4109 (defun anything-find-library-at-point ()
4110 "Try to find library path at point.
4111 Find inside `require' and `declare-function' sexp."
4112 (require 'find-func)
4113 (let* ((beg-sexp (save-excursion (search-backward "(" (point-at-bol) t)))
4114 (end-sexp (save-excursion (search-forward ")" (point-at-eol) t)))
4115 (sexp (and beg-sexp end-sexp
4116 (buffer-substring-no-properties
4117 (1+ beg-sexp) (1- end-sexp)))))
4118 (ignore-errors
4119 (cond ((and sexp (string-match "require \'.+[^)]" sexp))
4120 (find-library-name
4121 (replace-regexp-in-string
4122 "'\\|\)\\|\(" ""
4123 ;; If require use third arg, ignore it,
4124 ;; always use library path found in `load-path'.
4125 (second (split-string (match-string 0 sexp))))))
4126 ((and sexp (string-match-p "^declare-function" sexp))
4127 (find-library-name
4128 (replace-regexp-in-string
4129 "\"\\|ext:" ""
4130 (third (split-string sexp)))))
4131 (t nil)))))
4133 ;;; Anything completion for `write-file'.==> C-x C-w
4134 (defvar anything-c-source-write-file
4135 `((name . "Write File")
4136 (header-name . (lambda (name)
4137 (concat name anything-c-find-files-doc-header)))
4138 ;; It is needed for filenames with capital letters
4139 (disable-shortcuts)
4140 (candidates . anything-find-files-get-candidates)
4141 (filtered-candidate-transformer anything-c-find-files-transformer)
4142 (persistent-action . anything-find-files-persistent-action)
4143 (persistent-help . "Expand Candidate")
4144 (volatile)
4145 (action .
4146 (("Write File" . (lambda (candidate)
4147 (write-file candidate 'confirm)))))))
4149 ;;;###autoload
4150 (defun anything-write-file ()
4151 "Preconfigured `anything' providing completion for `write-file'."
4152 (interactive)
4153 (let ((anything-mp-highlight-delay nil))
4154 (anything :sources 'anything-c-source-write-file
4155 :input (expand-file-name default-directory)
4156 :prompt "Write buffer to file: "
4157 :buffer "*Anything write file*")))
4159 ;;; Anything completion for `insert-file'.==> C-x i
4160 (defvar anything-c-source-insert-file
4161 `((name . "Insert File")
4162 (header-name . (lambda (name)
4163 (concat name anything-c-find-files-doc-header)))
4164 ;; It is needed for filenames with capital letters
4165 (disable-shortcuts)
4166 (candidates . anything-find-files-get-candidates)
4167 (filtered-candidate-transformer anything-c-find-files-transformer)
4168 (persistent-action . anything-find-files-persistent-action)
4169 (persistent-help . "Expand Candidate")
4170 (volatile)
4171 (action .
4172 (("Insert File" . (lambda (candidate)
4173 (when (y-or-n-p (format "Really insert %s in %s "
4174 candidate anything-current-buffer))
4175 (insert-file-contents candidate))))))))
4177 ;;;###autoload
4178 (defun anything-insert-file ()
4179 "Preconfigured `anything' providing completion for `insert-file'."
4180 (interactive)
4181 (let ((anything-mp-highlight-delay nil))
4182 (anything :sources 'anything-c-source-insert-file
4183 :input (expand-file-name default-directory)
4184 :prompt "Insert file: "
4185 :buffer "*Anything insert file*")))
4187 ;;; Anything completion for copy, rename and (rel)sym/hard/link files from dired.
4188 (defvar anything-c-source-copy-files
4189 `((name . "Copy Files")
4190 (header-name . (lambda (name)
4191 (concat name anything-c-find-files-doc-header)))
4192 ;; It is needed for filenames with capital letters
4193 (disable-shortcuts)
4194 (candidates . anything-find-files-get-candidates)
4195 (filtered-candidate-transformer anything-c-find-files-transformer)
4196 (persistent-action . anything-find-files-persistent-action)
4197 (persistent-help . "Expand Candidate")
4198 (volatile)
4199 (action .
4200 (("Copy File"
4201 . (lambda (candidate)
4202 (anything-dired-action candidate :action 'copy)))
4203 ("Copy and Follow"
4204 . (lambda (candidate)
4205 (anything-dired-action candidate :action 'copy :follow t)))))))
4208 (defvar anything-c-source-rename-files
4209 `((name . "Rename Files")
4210 (header-name . (lambda (name)
4211 (concat name anything-c-find-files-doc-header)))
4212 ;; It is needed for filenames with capital letters
4213 (disable-shortcuts)
4214 (candidates . anything-find-files-get-candidates)
4215 (filtered-candidate-transformer anything-c-find-files-transformer)
4216 (persistent-action . anything-find-files-persistent-action)
4217 (persistent-help . "Expand Candidate")
4218 (volatile)
4219 (action .
4220 (("Rename File"
4221 . (lambda (candidate)
4222 (anything-dired-action candidate :action 'rename)))
4223 ("Rename and Follow"
4224 . (lambda (candidate)
4225 (anything-dired-action candidate :action 'rename :follow t)))))))
4227 (defvar anything-c-source-symlink-files
4228 `((name . "Symlink Files")
4229 (header-name . (lambda (name)
4230 (concat name anything-c-find-files-doc-header)))
4231 ;; It is needed for filenames with capital letters
4232 (disable-shortcuts)
4233 (candidates . anything-find-files-get-candidates)
4234 (filtered-candidate-transformer anything-c-find-files-transformer)
4235 (persistent-action . anything-find-files-persistent-action)
4236 (persistent-help . "Expand Candidate")
4237 (volatile)
4238 (action
4239 . (("Symlink File"
4240 . (lambda (candidate)
4241 (anything-dired-action candidate :action 'symlink)))
4242 ("RelSymlink File"
4243 . (lambda (candidate)
4244 (anything-dired-action candidate :action 'relsymlink)))))))
4247 (defvar anything-c-source-hardlink-files
4248 `((name . "Hardlink Files")
4249 (header-name . (lambda (name)
4250 (concat name anything-c-find-files-doc-header)))
4251 ;; It is needed for filenames with capital letters
4252 (disable-shortcuts)
4253 (candidates . anything-find-files-get-candidates)
4254 (filtered-candidate-transformer anything-c-find-files-transformer)
4255 (persistent-action . anything-find-files-persistent-action)
4256 (persistent-help . "Expand Candidate")
4257 (volatile)
4258 (action
4259 . (("Hardlink File"
4260 . (lambda (candidate)
4261 (anything-dired-action candidate :action 'hardlink)))))))
4263 (defun* anything-dired-action (candidate &key action follow (files (dired-get-marked-files)))
4264 "Copy, rename or symlink file at point or marked files in dired to CANDIDATE.
4265 ACTION is a key that can be one of 'copy, 'rename, 'symlink, 'relsymlink."
4266 (when (get-buffer dired-log-buffer) (kill-buffer dired-log-buffer))
4267 (let ((fn (case action
4268 ('copy 'dired-copy-file)
4269 ('rename 'dired-rename-file)
4270 ('symlink 'make-symbolic-link)
4271 ('relsymlink 'dired-make-relative-symlink)
4272 ('hardlink 'dired-hardlink)))
4273 (marker (case action
4274 ((copy rename) dired-keep-marker-copy)
4275 ('symlink dired-keep-marker-symlink)
4276 ('relsymlink dired-keep-marker-relsymlink)
4277 ('hardlink dired-keep-marker-hardlink)))
4278 (dirflag (and (= (length files) 1)
4279 (file-directory-p (car files))
4280 (not (file-directory-p candidate)))))
4281 (dired-create-files
4282 fn (symbol-name action) files
4283 ;; CANDIDATE is the destination.
4284 (if (file-directory-p candidate)
4285 ;; When CANDIDATE is a directory, build file-name in this directory.
4286 ;; Else we use CANDIDATE.
4287 #'(lambda (from)
4288 (expand-file-name (file-name-nondirectory from) candidate))
4289 #'(lambda (from) candidate))
4290 marker)
4291 (when (and follow (not (get-buffer dired-log-buffer)))
4292 (let ((moved-flist (anything-get-dest-fnames-from-list files candidate dirflag))
4293 (target (directory-file-name candidate)))
4294 (unwind-protect
4295 (progn
4296 (setq anything-ff-cand-to-mark moved-flist)
4297 (if (and dirflag (eq action 'rename))
4298 (anything-find-files-1 (file-name-directory target) target)
4299 (anything-find-files-1 (expand-file-name candidate))))
4300 (setq anything-ff-cand-to-mark nil))))))
4303 (defun anything-c-basename (fname)
4304 "Resolve basename of file or directory named FNAME."
4305 (file-name-nondirectory (directory-file-name fname)))
4307 (defun anything-get-dest-fnames-from-list (flist dest-cand rename-dir-flag)
4308 "Transform filenames of FLIST to abs of DEST-CAND."
4309 ;; At this point files have been renamed/copied at destination.
4310 ;; That's mean DEST-CAND exists.
4311 (loop
4312 with dest = (expand-file-name dest-cand)
4313 for src in flist
4314 for basename-src = (anything-c-basename src)
4315 for fname = (cond (rename-dir-flag (directory-file-name dest))
4316 ((file-directory-p dest)
4317 (concat (file-name-as-directory dest) basename-src))
4318 (t dest))
4319 when (file-exists-p fname)
4320 collect fname into tmp-list
4321 finally return (sort tmp-list 'string<)))
4323 (defun anything-c-maybe-mark-candidates ()
4324 "Mark all candidates of list `anything-ff-cand-to-mark'."
4325 (when (and (string= (assoc-default 'name (anything-get-current-source))
4326 (assoc-default 'name anything-c-source-find-files))
4327 anything-ff-cand-to-mark)
4328 (with-anything-window
4329 (while anything-ff-cand-to-mark
4330 (if (search-forward (car anything-ff-cand-to-mark) (point-at-eol) t)
4331 (progn
4332 (anything-mark-current-line)
4333 (anything-make-visible-mark)
4334 (forward-line 1)
4335 (setq anything-ff-cand-to-mark (cdr anything-ff-cand-to-mark)))
4336 (forward-line 1)))
4337 (unless (anything-this-visible-mark)
4338 (anything-prev-visible-mark)))))
4340 (add-hook 'anything-after-update-hook #'anything-c-maybe-mark-candidates)
4342 (defun* anything-dired-do-action-on-file (&key action)
4343 (let* ((files (dired-get-marked-files))
4344 (len (length files))
4345 (fname (if (> len 1)
4346 (format "* %d Files" len)
4347 (car files)))
4348 (source (case action
4349 ('copy 'anything-c-source-copy-files)
4350 ('rename 'anything-c-source-rename-files)
4351 ('symlink 'anything-c-source-symlink-files)
4352 ('hardlink 'anything-c-source-hardlink-files)))
4353 (prompt-fm (case action
4354 ('copy "Copy %s to: ")
4355 ('rename "Rename %s to: ")
4356 ('symlink "Symlink %s to: ")
4357 ('hardlink "Hardlink %s to: ")))
4358 (buffer (case action
4359 ('copy "*Anything Copy Files*")
4360 ('rename "*Anything Rename Files*")
4361 ('symlink "*Anything Symlink Files*")
4362 ('hardlink "*Anything Hardlink Files*")))
4363 (anything-mp-highlight-delay nil))
4364 (anything :sources source
4365 :input (or (dired-dwim-target-directory)
4366 (expand-file-name (anything-c-current-directory)))
4367 :preselect (dired-get-filename)
4368 :prompt (format prompt-fm fname)
4369 :keymap anything-c-read-file-map
4370 :buffer buffer)))
4372 ;;;###autoload
4373 (defun anything-dired-rename-file ()
4374 "Preconfigured `anything' to rename files from dired."
4375 (interactive)
4376 (anything-dired-do-action-on-file :action 'rename))
4378 ;;;###autoload
4379 (defun anything-dired-copy-file ()
4380 "Preconfigured `anything' to copy files from dired."
4381 (interactive)
4382 (anything-dired-do-action-on-file :action 'copy))
4384 ;;;###autoload
4385 (defun anything-dired-symlink-file ()
4386 "Preconfigured `anything' to symlink files from dired."
4387 (interactive)
4388 (anything-dired-do-action-on-file :action 'symlink))
4390 ;;;###autoload
4391 (defun anything-dired-hardlink-file ()
4392 "Preconfigured `anything' to hardlink files from dired."
4393 (interactive)
4394 (anything-dired-do-action-on-file :action 'hardlink))
4396 ;;;###autoload
4397 (define-minor-mode anything-dired-mode ()
4398 "Enable anything completion in Dired functions.
4399 Bindings affected are C, R, S, H."
4400 :group 'anything-config
4401 :global t
4402 (if anything-dired-mode
4403 (progn
4404 (substitute-key-definition
4405 'dired-do-copy 'anything-dired-copy-file dired-mode-map)
4406 (substitute-key-definition
4407 'dired-do-rename 'anything-dired-rename-file dired-mode-map)
4408 (substitute-key-definition
4409 'dired-do-symlink 'anything-dired-symlink-file dired-mode-map)
4410 (substitute-key-definition
4411 'dired-do-hardlink 'anything-dired-hardlink-file dired-mode-map))
4412 (substitute-key-definition
4413 'anything-dired-copy-file 'dired-do-copy dired-mode-map)
4414 (substitute-key-definition
4415 'anything-dired-rename-file 'dired-do-rename dired-mode-map)
4416 (substitute-key-definition
4417 'anything-dired-symlink-file 'dired-do-symlink dired-mode-map)
4418 (substitute-key-definition
4419 'anything-dired-hardlink-file 'dired-do-hardlink dired-mode-map)))
4421 (defalias 'anything-dired-bindings 'anything-dired-mode)
4423 (defun* anything-c-read-file-name (prompt
4424 &key
4425 (initial-input (expand-file-name default-directory))
4426 (buffer "*Anything Completions*")
4427 test
4428 (preselect nil)
4429 must-match
4430 (history nil)
4431 (marked-candidates nil)
4432 (alistp t)
4433 (persistent-action 'anything-find-files-persistent-action)
4434 (persistent-help "Hit1 Expand Candidate, Hit2 or (C-u) Find file"))
4435 "Anything `read-file-name' emulation.
4436 INITIAL-INPUT is a valid path, TEST is a predicate that take one arg."
4437 (when (get-buffer anything-action-buffer)
4438 (kill-buffer anything-action-buffer))
4439 (let ((anything-mp-highlight-delay nil))
4440 (flet ((action-fn (candidate)
4441 (if marked-candidates
4442 (anything-marked-candidates)
4443 (identity candidate))))
4444 (or (anything
4445 :sources
4446 `(((name . "Read File Name History")
4447 (header-name . (lambda (name)
4448 (concat name anything-c-find-files-doc-header)))
4449 (disable-shortcuts)
4450 (candidates . (lambda ()
4451 (anything-comp-read-get-candidates history nil nil alistp)))
4452 (persistent-action . ,persistent-action)
4453 (persistent-help . ,persistent-help)
4454 (action . ,'action-fn))
4455 ((name . "Read file name")
4456 (header-name . (lambda (name)
4457 (concat name anything-c-find-files-doc-header)))
4458 ;; It is needed for filenames with capital letters
4459 (disable-shortcuts)
4460 (candidates . (lambda ()
4461 (let ((seq (anything-find-files-get-candidates)))
4462 (if test
4463 (loop
4464 for fname in seq when (funcall test fname)
4465 collect fname into ls
4466 finally return
4467 (if must-match ls
4468 (append (list anything-pattern) ls)))
4469 (if must-match
4470 (if (file-exists-p (car seq)) seq (cdr seq))
4471 seq)))))
4472 (filtered-candidate-transformer anything-c-find-files-transformer)
4473 (persistent-action . ,persistent-action)
4474 (candidate-number-limit . 9999)
4475 (toggle-auto-update . anything-ff-toggle-auto-update)
4476 (persistent-help . ,persistent-help)
4477 (volatile)
4478 (action . ,'action-fn)))
4479 :input initial-input
4480 :prompt prompt
4481 :keymap anything-c-read-file-map
4482 :resume 'noresume
4483 :buffer buffer
4484 :preselect preselect)
4485 (keyboard-quit)))))
4487 ;;; File Cache
4488 (defvar anything-c-file-cache-initialized-p nil)
4490 (defvar anything-c-file-cache-files nil)
4492 (defvar anything-c-source-file-cache
4493 '((name . "File Cache")
4494 (init
4495 . (lambda ()
4496 (require 'filecache nil t)
4497 (unless anything-c-file-cache-initialized-p
4498 (setq anything-c-file-cache-files
4499 (loop for item in file-cache-alist append
4500 (destructuring-bind (base &rest dirs) item
4501 (loop for dir in dirs collect
4502 (concat dir base)))))
4503 (defadvice file-cache-add-file (after file-cache-list activate)
4504 (add-to-list 'anything-c-file-cache-files (expand-file-name file)))
4505 (setq anything-c-file-cache-initialized-p t))))
4506 (candidates . anything-c-file-cache-files)
4507 (match anything-c-match-on-file-name
4508 anything-c-match-on-directory-name)
4509 (type . file)))
4510 ;; (anything 'anything-c-source-file-cache)
4512 ;;; Locate
4513 ;; NOTE for WINDOZE users:
4514 ;; You have to install Everything with his command line interface here:
4515 ;; http://www.voidtools.com/download.php
4517 (defvar anything-c-locate-command
4518 (case system-type
4519 ('gnu/linux "locate -i -r %s")
4520 ('berkeley-unix "locate -i %s")
4521 ('windows-nt "es -i -r %s")
4522 (t "locate %s"))
4523 "A list of arguments for locate program.
4524 The \"-r\" option must be the last option.")
4526 (defun anything-locate-with-db (&optional db)
4527 "Run locate -d DB.
4528 If DB is not given or nil use locate without -d option.
4529 DB can be given as a string or list of db files.
4530 See also `anything-locate'."
4531 (when (and db (stringp db)) (setq db (list db)))
4532 (let ((anything-c-locate-command
4533 (if db
4534 (replace-regexp-in-string
4535 "locate"
4536 (format "locate -d %s"
4537 (mapconcat 'identity
4538 ;; Remove eventually marked directories by error.
4539 (loop for i in db unless
4540 (file-directory-p i) collect i) ":"))
4541 anything-c-locate-command)
4542 anything-c-locate-command)))
4543 (anything :sources 'anything-c-source-locate
4544 :buffer "*anything locate*"
4545 :keymap anything-generic-files-map)))
4546 ;; (anything-locate-with-db "~/locate.db")
4548 (defun anything-c-locate-init ()
4549 "Initialize async locate process for `anything-c-source-locate'."
4550 (setq mode-line-format
4551 '(" " mode-line-buffer-identification " "
4552 (line-number-mode "%l") " "
4553 (:eval (propertize "(Locate Process Running) "
4554 'face '((:foreground "red"))))))
4555 (prog1
4556 (start-process-shell-command "locate-process" nil
4557 (format anything-c-locate-command
4558 anything-pattern))
4559 (set-process-sentinel (get-process "locate-process")
4560 #'(lambda (process event)
4561 (when (string= event "finished\n")
4562 (with-anything-window
4563 (force-mode-line-update nil)
4564 (anything-update-move-first-line)))))))
4566 (defvar anything-c-source-locate
4567 '((name . "Locate")
4568 (candidates . anything-c-locate-init)
4569 (type . file)
4570 (properties-action . anything-ff-properties)
4571 (requires-pattern . 3)
4572 (mode-line . anything-generic-file-mode-line-string)
4573 (delayed))
4574 "Find files matching the current input pattern with locate.")
4575 ;; (anything 'anything-c-source-locate)
4578 ;;; Anything Incremental Grep.
4581 ;; Allow to grep incrementally with anything interface.
4582 ;; It allow also to Grep files recursively without using 'find' shell command.
4583 ;; On Windows you will need at least Grep version 2.5.4 of Gnuwin32.
4584 (defvar anything-c-grep-default-command
4585 "grep -d skip %e -niH -e %p %f"
4586 "Default grep format command for `anything-do-grep-1'.
4587 Where:
4588 '%e' format spec is for --exclude or --include grep options.
4589 '%p' format spec is for pattern.
4590 '%f' format spec is for filenames.")
4592 (defvar anything-c-grep-default-recurse-command
4593 "grep -d recurse %e -niH -e %p %f"
4594 "Default recursive grep format command for `anything-do-grep-1'.
4595 See `anything-c-grep-default-command' for format specs.")
4597 (defvar anything-c-default-zgrep-command "zgrep -niH -e %p %f")
4599 (defvar anything-c-rzgrep-cache (make-hash-table :test 'equal))
4601 (defvar anything-c-grep-default-function 'anything-c-grep-init)
4603 (defvar anything-c-grep-debug-command-line nil
4604 "Turn on anything grep command-line debugging when non--nil.")
4606 (defvar anything-c-zgrep-recurse-flag nil)
4608 (defvar anything-c-grep-history nil)
4610 (defvar anything-c-grep-max-length-history 100
4611 "*Max number of elements to save in `anything-c-grep-history'.")
4613 (defun anything-c-grep-prepare-candidates (candidates)
4614 "Prepare filenames and directories CANDIDATES for grep command line."
4615 ;; If one or more candidate is a directory, search in all files
4616 ;; of this candidate (e.g /home/user/directory/*).
4617 ;; If r option is enabled search also in subdidrectories.
4618 ;; We need here to expand wildcards to support crap windows filenames
4619 ;; as grep don't accept quoted wildcards (e.g "dir/*.el").
4620 (if anything-c-zgrep-recurse-flag
4621 (mapconcat 'shell-quote-argument candidates " ")
4622 (loop for i in candidates append
4623 (cond ( ;; Candidate is a directory and we use recursion.
4624 (and (file-directory-p i)
4625 (anything-c-grep-recurse-p))
4626 (list (expand-file-name i)))
4627 ;; Candidate is a directory, search in all files.
4628 ((file-directory-p i)
4629 (file-expand-wildcards
4630 (concat (file-name-as-directory (expand-file-name i)) "*") t))
4631 ;; Candidate is a file or wildcard and we use recursion, use the
4632 ;; current directory instead of candidate.
4633 ((and (or (file-exists-p i) (string-match "\*" i))
4634 (anything-c-grep-recurse-p))
4635 (list (expand-file-name
4636 (directory-file-name ; Needed for windoze.
4637 (file-name-directory (directory-file-name i))))))
4638 ;; Candidate use wildcard.
4639 ((string-match "^\*" (anything-c-basename i))
4640 (file-expand-wildcards i t))
4641 ;; Else should be one or more file.
4642 (t (list i))) into all-files
4643 finally return
4644 (mapconcat 'shell-quote-argument all-files " "))))
4646 (defun anything-c-grep-recurse-p ()
4647 "Check if `anything-do-grep-1' have switched to recursive."
4648 (let ((args (replace-regexp-in-string
4649 "grep" "" anything-c-grep-default-command)))
4650 (string-match-p "r\\|recurse" args)))
4652 (defun anything-c-grep-init (only-files &optional include zgrep)
4653 "Start an asynchronous grep process in ONLY-FILES list."
4654 (let* ((fnargs (anything-c-grep-prepare-candidates
4655 (if (file-remote-p anything-ff-default-directory)
4656 (mapcar #'(lambda (x)
4657 (file-remote-p x 'localname))
4658 only-files)
4659 only-files)))
4660 (ignored-files (mapconcat
4661 #'(lambda (x)
4662 (concat "--exclude=" (shell-quote-argument x)))
4663 grep-find-ignored-files " "))
4664 (ignored-dirs (mapconcat
4665 ;; Need grep version 2.5.4 of Gnuwin32 on windoze.
4666 #'(lambda (x)
4667 (concat "--exclude-dir=" (shell-quote-argument x)))
4668 grep-find-ignored-directories " "))
4669 (exclude (if (anything-c-grep-recurse-p)
4670 (concat (or include ignored-files) " " ignored-dirs)
4671 ignored-files))
4672 (cmd-line (format-spec
4673 anything-c-grep-default-command
4674 (delq nil
4675 (list (unless zgrep (cons ?e exclude))
4676 (cons ?p (shell-quote-argument anything-pattern))
4677 (cons ?f fnargs))))))
4678 (when anything-c-grep-debug-command-line
4679 (with-current-buffer (get-buffer-create "*any grep debug*")
4680 (goto-char (point-max))
4681 (insert (concat ">>> " cmd-line "\n\n"))))
4682 (setq mode-line-format
4683 '(" " mode-line-buffer-identification " "
4684 (line-number-mode "%l") " "
4685 (:eval (when (get-process "grep-process")
4686 (propertize "[Grep Process Running] "
4687 'face 'anything-grep-running)))))
4688 (force-mode-line-update nil)
4689 (prog1
4690 (let ((default-directory anything-ff-default-directory))
4691 (start-file-process-shell-command "grep-process" nil cmd-line))
4692 (message nil)
4693 (set-process-sentinel
4694 (get-process "grep-process")
4695 #'(lambda (process event)
4696 (when (string= event "finished\n")
4697 (with-anything-window
4698 (anything-update-move-first-line)
4699 (setq mode-line-format
4700 '(" " mode-line-buffer-identification " "
4701 (line-number-mode "%l") " "
4702 (:eval (propertize
4703 (format "[Grep Process Finished - (%s results)] "
4704 (let ((nlines (1- (count-lines
4705 (point-min)
4706 (point-max)))))
4707 (if (> nlines 0) nlines 0)))
4708 'face 'anything-grep-finish))))
4709 (force-mode-line-update nil))))))))
4711 (defun anything-c-grep-action (candidate &optional where mark)
4712 "Define a default action for `anything-do-grep' on CANDIDATE.
4713 WHERE can be one of other-window, elscreen, other-frame."
4714 (let* ((split (anything-c-grep-split-line candidate))
4715 (lineno (string-to-number (nth 1 split)))
4716 (loc-fname (car split))
4717 (tramp-method (file-remote-p anything-ff-default-directory 'method))
4718 (tramp-host (file-remote-p anything-ff-default-directory 'host))
4719 (tramp-prefix (concat "/" tramp-method ":" tramp-host ":"))
4720 (fname (if tramp-host
4721 (concat tramp-prefix loc-fname) loc-fname)))
4722 (case where
4723 (other-window (find-file-other-window fname))
4724 (elscreen (anything-elscreen-find-file fname))
4725 (other-frame (find-file-other-frame fname))
4726 (t (find-file fname)))
4727 (anything-goto-line lineno)
4728 (when mark
4729 (set-marker (mark-marker) (point))
4730 (push-mark (point) 'nomsg))
4731 ;; Save history
4732 (unless (or anything-in-persistent-action
4733 (string= anything-pattern ""))
4734 (setq anything-c-grep-history
4735 (cons anything-pattern
4736 (delete anything-pattern anything-c-grep-history)))
4737 (when (> (length anything-c-grep-history)
4738 anything-c-grep-max-length-history)
4739 (setq anything-c-grep-history
4740 (delete (car (last anything-c-grep-history))
4741 anything-c-grep-history))))))
4743 (defun anything-c-grep-other-window (candidate)
4744 "Jump to result in other window from anything grep."
4745 (anything-c-grep-action candidate 'other-window))
4747 (defun anything-c-grep-other-frame (candidate)
4748 "Jump to result in other frame from anything grep."
4749 (anything-c-grep-action candidate 'other-frame))
4751 (defun anything-c-grep-jump-elscreen (candidate)
4752 "Jump to result in elscreen from anything grep."
4753 (anything-c-grep-action candidate 'elscreen))
4755 (defun anything-c-grep-save-results (candidate)
4756 "Save anything grep result in a `grep-mode' buffer."
4757 (let ((buf "*grep*")
4758 new-buf)
4759 (when (get-buffer buf)
4760 (setq new-buf (read-string "GrepBufferName: " buf))
4761 (loop for b in (anything-c-buffer-list)
4762 when (and (string= new-buf b)
4763 (not (y-or-n-p
4764 (format "Buffer `%s' already exists overwrite? "
4765 new-buf))))
4766 do (setq new-buf (read-string "GrepBufferName: " "*grep ")))
4767 (setq buf new-buf))
4768 (with-current-buffer (get-buffer-create buf)
4769 (let ((inhibit-read-only t))
4770 (erase-buffer)
4771 (insert "-*- mode: grep -*-\n\n"
4772 (format "Grep Results for `%s':\n\n" anything-pattern))
4773 (save-excursion
4774 (insert (with-current-buffer anything-buffer
4775 (forward-line 1)
4776 (buffer-substring (point) (point-max))))
4777 (grep-mode))))
4778 (message "Anything Grep Results saved in `%s' buffer" buf)))
4780 (defun anything-c-grep-persistent-action (candidate)
4781 "Persistent action for `anything-do-grep'.
4782 With a prefix arg record CANDIDATE in `mark-ring'."
4783 (if current-prefix-arg
4784 (anything-c-grep-action candidate nil 'mark)
4785 (anything-c-grep-action candidate))
4786 (anything-match-line-color-current-line))
4788 (defun anything-c-grep-guess-extensions (files)
4789 "Try to guess file extensions in FILES list when using grep recurse.
4790 These extensions will be added to command line with --include arg of grep."
4791 (loop
4792 with glob-list = nil
4793 with lst = (if (file-directory-p (car files))
4794 (directory-files
4795 (car files) nil
4796 directory-files-no-dot-files-regexp)
4797 files)
4798 for i in lst
4799 for ext = (file-name-extension i t)
4800 for glob = (and ext (not (string= ext ""))
4801 (concat "*" ext))
4802 unless (or (not glob)
4803 (member glob glob-list)
4804 (member glob grep-find-ignored-files))
4805 collect glob into glob-list
4806 finally return glob-list))
4808 (defun anything-do-grep-1 (only &optional recurse zgrep)
4809 "Launch grep with a list of ONLY files.
4810 When RECURSE is given use -r option of grep and prompt user
4811 to set the --include args of grep.
4812 You can give more than one arg separated by space.
4813 e.g *.el *.py *.tex.
4814 If it's empty --exclude `grep-find-ignored-files' is used instead."
4815 (let* ((anything-compile-source-functions
4816 ;; rule out anything-match-plugin because the input is one regexp.
4817 (delq 'anything-compile-source--match-plugin
4818 (copy-sequence anything-compile-source-functions)))
4819 (exts (anything-c-grep-guess-extensions only))
4820 (globs (and (not zgrep) (mapconcat 'identity exts " ")))
4821 (include-files (and recurse (not zgrep)
4822 (read-string "OnlyExt(*.[ext]): "
4823 globs)))
4824 ;; Set `minibuffer-history' AFTER includes-files
4825 ;; to avoid storing wild-cards here.
4826 (minibuffer-history anything-c-grep-history)
4827 (anything-c-grep-default-command (cond ((and recurse zgrep) anything-c-default-zgrep-command)
4828 (recurse anything-c-grep-default-recurse-command)
4829 (zgrep anything-c-default-zgrep-command)
4830 (t anything-c-grep-default-command)))
4831 ;; Disable match-plugin and use here own highlighting.
4832 (anything-mp-highlight-delay nil))
4833 (when include-files
4834 (setq include-files
4835 (and (not (string= include-files ""))
4836 (mapconcat #'(lambda (x)
4837 (concat "--include=" (shell-quote-argument x)))
4838 (split-string include-files) " "))))
4839 ;; When called as action from an other source e.g *-find-files
4840 ;; we have to kill action buffer.
4841 (when (get-buffer anything-action-buffer)
4842 (kill-buffer anything-action-buffer))
4843 ;; `anything-find-files' haven't already started,
4844 ;; give a default value to `anything-ff-default-directory'.
4845 (setq anything-ff-default-directory (or anything-ff-default-directory
4846 default-directory))
4847 (anything
4848 :sources
4849 `(((name . "Grep (C-c ? Help)")
4850 (candidates
4851 . (lambda ()
4852 (funcall anything-c-grep-default-function only include-files zgrep)))
4853 (filtered-candidate-transformer anything-c-grep-cand-transformer)
4854 (candidate-number-limit . 9999)
4855 (mode-line . anything-grep-mode-line-string)
4856 (jump-persistent . anything-c-grep-persistent-action)
4857 (action . ,(delq
4859 `(("Find File" . anything-c-grep-action)
4860 ("Find file other frame" . anything-c-grep-other-frame)
4861 ,(and (locate-library "elscreen")
4862 '("Find file in Elscreen"
4863 . anything-c-grep-jump-elscreen))
4864 ("Save results in grep buffer" . anything-c-grep-save-results)
4865 ("Find file other window" . anything-c-grep-other-window))))
4866 (persistent-action . anything-c-grep-persistent-action)
4867 (persistent-help . "Jump to line (`C-u' Record in mark ring)")
4868 (requires-pattern . 3)
4869 (delayed)))
4870 :keymap anything-c-grep-map
4871 :buffer "*anything grep*")))
4873 ;;;###autoload
4874 (defun anything-do-grep ()
4875 "Preconfigured anything for grep.
4876 Contrarily to Emacs `grep' no default directory is given, but
4877 the full path of candidates in ONLY.
4878 That allow to grep different files not only in `default-directory' but anywhere
4879 by marking them (C-<SPACE>). If one or more directory is selected
4880 grep will search in all files of these directories.
4881 You can use also wildcard in the base name of candidate.
4882 If a prefix arg is given use the -r option of grep.
4883 The prefix arg can be passed before or after start.
4884 See also `anything-do-grep-1'."
4885 (interactive)
4886 (let ((only (anything-c-read-file-name
4887 "Search in file(s): "
4888 :marked-candidates t
4889 :preselect (or (dired-get-filename nil t)
4890 (buffer-file-name (current-buffer)))))
4891 (prefarg (or current-prefix-arg anything-current-prefix-arg)))
4892 (anything-do-grep-1 only prefarg)))
4894 (defmacro* anything-c-walk-directory (directory &key (path 'basename) (directories t) match)
4895 "Walk through DIRECTORY tree.
4896 PATH can be one of basename, relative, or full.
4897 DIRECTORIES when non--nil (default) return also directories names, otherwise
4898 skip directories names.
4899 MATCH match only filenames matching regexp MATCH."
4900 `(let (result
4901 (fn (case ,path
4902 (basename 'file-name-nondirectory)
4903 (relative 'file-relative-name)
4904 (full 'identity)
4905 (t (error "Error: Invalid path spec `%s', must be one of basename, relative or full." ,path)))))
4906 (labels ((ls-R (dir)
4907 (loop with ls = (directory-files dir t directory-files-no-dot-files-regexp)
4908 for f in ls
4909 if (file-directory-p f)
4910 do (progn (when ,directories
4911 (push (funcall fn f) result))
4912 ;; Don't recurse in directory symlink.
4913 (unless (file-symlink-p f)
4914 (ls-R f)))
4915 else do
4916 (unless (and ,match (not (string-match ,match (file-name-nondirectory f))))
4917 (push (funcall fn f) result)))))
4918 (ls-R ,directory)
4919 (nreverse result))))
4921 (defun anything-ff-zgrep-1 (flist recursive)
4922 (unwind-protect
4923 (let* ((def-dir (or anything-ff-default-directory
4924 default-directory))
4925 (only (if recursive
4926 (or (gethash def-dir anything-c-rzgrep-cache)
4927 (puthash
4928 def-dir
4929 (anything-c-walk-directory
4930 def-dir
4931 :directories nil
4932 :path 'full
4933 :match ".*\\(\.gz\\|\.bz\\|\.xz\\|\.lzma\\)$")
4934 anything-c-rzgrep-cache))
4935 flist)))
4936 (when recursive (setq anything-c-zgrep-recurse-flag t))
4937 (anything-do-grep-1 only recursive 'zgrep))
4938 (setq anything-c-zgrep-recurse-flag nil)))
4940 ;;;###autoload
4941 (defun anything-do-zgrep (candidate)
4942 "Preconfigured anything for zgrep."
4943 (let ((prefarg (or current-prefix-arg anything-current-prefix-arg))
4944 (ls (anything-c-read-file-name
4945 "Search in file(s): "
4946 :marked-candidates t
4947 :preselect (or (dired-get-filename nil t)
4948 (buffer-file-name (current-buffer))))))
4949 (anything-ff-zgrep-1 ls prefarg)))
4951 (defun anything-c-grep-split-line (line)
4952 "Split a grep output line."
4953 (let (beg fname lineno str)
4954 ;; Don't print until grep line is valid.
4955 (when (string-match "\\(.*\\)\\(:[0-9]+:\\)\\(.*\\)" line)
4956 (with-temp-buffer
4957 (insert line)
4958 (goto-char (point-min))
4959 (setq beg (point))
4960 (forward-char 2)
4961 (re-search-forward ":" nil t)
4962 (setq fname (buffer-substring-no-properties beg (1- (point))))
4963 (setq beg (point))
4964 (re-search-forward ":" nil t)
4965 (setq lineno (buffer-substring-no-properties beg (1- (point))))
4966 (setq str (buffer-substring-no-properties (point) (point-at-eol))))
4967 (list fname lineno str))))
4969 (defun anything-c-grep-cand-transformer (candidates sources)
4970 "Filtered candidate transformer function for `anything-do-grep'."
4971 (loop for i in candidates
4972 for split = (and i (anything-c-grep-split-line i))
4973 for fname = (car split)
4974 for lineno = (nth 1 split)
4975 for str = (nth 2 split)
4976 when (and fname lineno str)
4977 collect
4978 (cons (concat (propertize (file-name-nondirectory fname)
4979 'face 'anything-grep-file
4980 'help-echo fname) ":"
4981 (propertize lineno 'face 'anything-grep-lineno) ":"
4982 (anything-c-grep-highlight-match str))
4983 i)))
4985 (defun anything-c-grep-highlight-match (str)
4986 "Highlight in string STR all occurences matching `anything-pattern'."
4987 (condition-case nil
4988 (with-temp-buffer
4989 (insert str)
4990 (goto-char (point-min))
4991 (while (and (re-search-forward anything-pattern nil t)
4992 (> (- (match-end 0) (match-beginning 0)) 0))
4993 (add-text-properties
4994 (match-beginning 0) (match-end 0)
4995 '(face anything-grep-match)))
4996 (buffer-string))
4997 (error nil)))
4999 ;; Go to next or precedent file (common to etags and grep).
5000 (defun anything-c-goto-next-or-prec-file (n)
5001 "Go to next or precedent candidate file in anything grep/etags buffers.
5002 If N is positive go forward otherwise go backward."
5003 (with-anything-window
5004 (let* ((current-line-list (split-string
5005 (buffer-substring
5006 (point-at-bol)
5007 (point-at-eol)) ":"))
5008 (current-fname (nth 0 current-line-list))
5009 (fn-b-o-f (if (eq n 1) 'eobp 'bobp)))
5010 (catch 'break
5011 (while (not (funcall fn-b-o-f))
5012 (forward-line n) ; Go forward or backward depending of n value.
5013 (unless (search-forward current-fname (point-at-eol) t)
5014 (anything-mark-current-line)
5015 (throw 'break nil))))
5016 (cond ((and (eq n 1) (eobp))
5017 (re-search-backward ".")
5018 (forward-line 0)
5019 (anything-mark-current-line))
5020 ((and (< n 1) (bobp))
5021 (forward-line 1)
5022 (anything-mark-current-line))))))
5024 ;;;###autoload
5025 (defun anything-c-goto-precedent-file ()
5026 "Go to precedent file in anything grep/etags buffers."
5027 (interactive)
5028 (anything-c-goto-next-or-prec-file -1))
5030 ;;;###autoload
5031 (defun anything-c-goto-next-file ()
5032 "Go to precedent file in anything grep/etags buffers."
5033 (interactive)
5034 (anything-c-goto-next-or-prec-file 1))
5036 ;;;###autoload
5037 (defun anything-c-grep-run-persistent-action ()
5038 "Run grep persistent action from `anything-do-grep-1'."
5039 (interactive)
5040 (anything-execute-persistent-action 'jump-persistent))
5042 ;;;###autoload
5043 (defun anything-c-grep-run-default-action ()
5044 "Run grep default action from `anything-do-grep-1'."
5045 (interactive)
5046 (anything-c-quit-and-execute-action 'anything-c-grep-action))
5048 ;;;###autoload
5049 (defun anything-c-grep-run-other-window-action ()
5050 "Run grep goto other window action from `anything-do-grep-1'."
5051 (interactive)
5052 (anything-c-quit-and-execute-action 'anything-c-grep-other-window))
5054 ;;;###autoload
5055 (defun anything-c-grep-run-save-buffer ()
5056 "Run grep save results action from `anything-do-grep-1'."
5057 (interactive)
5058 (anything-c-quit-and-execute-action 'anything-c-grep-save-results))
5060 ;; Grep buffers
5061 (defun anything-c-grep-buffers-1 (candidate &optional zgrep)
5062 "Run grep on all file--buffers or CANDIDATE if it is a file--buffer.
5063 If one of selected buffers is not a file--buffer,
5064 it is ignored and grep will run on all others file--buffers.
5065 If only one candidate is selected and it is not a file--buffer,
5066 switch to this buffer and run `anything-occur'.
5067 If a prefix arg is given run grep on all buffers ignoring non--file-buffers."
5068 (let* ((prefarg (or current-prefix-arg anything-current-prefix-arg))
5069 (cands (if prefarg
5070 (buffer-list)
5071 (anything-marked-candidates)))
5072 (win-conf (current-window-configuration))
5073 ;; Non--fname buffers are ignored.
5074 (bufs (loop for buf in cands
5075 for fname = (buffer-file-name (get-buffer buf))
5076 when fname
5077 collect (expand-file-name fname))))
5078 (if bufs
5079 (if zgrep
5080 (anything-do-grep-1 bufs nil 'zgrep)
5081 (anything-do-grep-1 bufs))
5082 ;; bufs is empty, thats mean we have only CANDIDATE
5083 ;; and it is not a buffer-filename, fallback to occur.
5084 (anything-c-switch-to-buffer candidate)
5085 (when (get-buffer anything-action-buffer)
5086 (kill-buffer anything-action-buffer))
5087 (anything-occur)
5088 (when (eq anything-exit-status 1)
5089 (set-window-configuration win-conf)))))
5091 (defun anything-c-grep-buffers (candidate)
5092 "Action to grep buffers."
5093 (anything-c-grep-buffers-1 candidate))
5095 (defun anything-c-zgrep-buffers (candidate)
5096 "Action to zgrep buffers."
5097 (anything-c-grep-buffers-1 candidate 'zgrep))
5099 ;;; Anything interface for pdfgrep
5100 ;; pdfgrep program <http://pdfgrep.sourceforge.net/>
5101 ;; and a pdf-reader (e.g xpdf) are needed.
5103 (defvar anything-c-pdfgrep-default-command "pdfgrep --color never -niH %s %s")
5104 (defvar anything-c-pdfgrep-default-function 'anything-c-pdfgrep-init)
5105 (defvar anything-c-pdfgrep-debug-command-line nil)
5107 (defun anything-c-pdfgrep-init (only-files)
5108 "Start an asynchronous pdfgrep process in ONLY-FILES list."
5109 (let* ((fnargs (anything-c-grep-prepare-candidates
5110 (if (file-remote-p anything-ff-default-directory)
5111 (mapcar #'(lambda (x)
5112 (file-remote-p x 'localname))
5113 only-files)
5114 only-files)))
5115 (cmd-line (format anything-c-pdfgrep-default-command
5116 anything-pattern
5117 fnargs)))
5118 (when anything-c-pdfgrep-debug-command-line
5119 (with-current-buffer (get-buffer-create "*any pdfgrep debug*")
5120 (goto-char (point-max))
5121 (insert (concat ">>> " cmd-line "\n\n"))))
5122 (setq mode-line-format
5123 '(" " mode-line-buffer-identification " "
5124 (line-number-mode "%l") " "
5125 (:eval (propertize "(Pdfgrep Process Running) "
5126 'face '((:foreground "red"))))))
5127 (prog1
5128 (let ((default-directory anything-ff-default-directory))
5129 (start-file-process-shell-command "pdfgrep-process" nil cmd-line))
5130 (message nil)
5131 (set-process-sentinel
5132 (get-process "pdfgrep-process")
5133 #'(lambda (process event)
5134 (when (string= event "finished\n")
5135 (with-anything-window
5136 (anything-update-move-first-line))
5137 (force-mode-line-update nil)))))))
5140 (defun anything-do-pdfgrep-1 (only)
5141 "Launch pdfgrep with a list of ONLY files."
5142 (unless (executable-find "pdfgrep")
5143 (error "Error: No such program `pdfgrep'."))
5144 (let* ((anything-compile-source-functions
5145 ;; rule out anything-match-plugin because the input is one regexp.
5146 (delq 'anything-compile-source--match-plugin
5147 (copy-sequence anything-compile-source-functions)))
5148 ;; Disable match-plugin and use here own highlighting.
5149 (anything-mp-highlight-delay nil))
5150 ;; When called as action from an other source e.g *-find-files
5151 ;; we have to kill action buffer.
5152 (when (get-buffer anything-action-buffer)
5153 (kill-buffer anything-action-buffer))
5154 ;; If `anything-find-files' haven't already started,
5155 ;; give a default value to `anything-ff-default-directory'.
5156 (setq anything-ff-default-directory (or anything-ff-default-directory
5157 default-directory))
5158 (anything
5159 :sources
5160 `(((name . "PdfGrep")
5161 (candidates
5162 . (lambda ()
5163 (funcall anything-c-pdfgrep-default-function only)))
5164 (filtered-candidate-transformer anything-c-grep-cand-transformer)
5165 (candidate-number-limit . 9999)
5166 (mode-line . anything-pdfgrep-mode-line-string)
5167 (action . anything-c-pdfgrep-action)
5168 (persistent-help . "Jump to PDF Page")
5169 (requires-pattern . 3)
5170 (delayed)))
5171 :keymap anything-c-pdfgrep-map
5172 :buffer "*anything grep*")))
5175 (defun anything-c-pdfgrep-action (candidate)
5176 (let* ((split (anything-c-grep-split-line candidate))
5177 (pageno (nth 1 split))
5178 (fname (car split)))
5179 (start-file-process-shell-command
5180 "pdf-reader" nil
5181 (format-spec anything-c-pdfgrep-default-read-command
5182 (list (cons ?f fname) (cons ?p pageno))))))
5184 (defun anything-do-pdfgrep ()
5185 (interactive)
5186 (let ((only (anything-c-read-file-name
5187 "Search in file(s): "
5188 :marked-candidates t
5189 :test #'(lambda (file)
5190 (or (string= (file-name-extension file) "pdf")
5191 (string= (file-name-extension file) "PDF")
5192 (file-directory-p file)))
5193 :preselect (or (dired-get-filename nil t)
5194 (buffer-file-name (current-buffer)))))
5195 (anything-c-grep-default-function 'anything-c-pdfgrep-init))
5196 (anything-do-pdfgrep-1 only)))
5199 ;; Yank text at point.
5202 ;; Internal
5203 (defvar anything-yank-point nil)
5205 ;;;###autoload
5206 (defun anything-yank-text-at-point ()
5207 "Yank text at point in minibuffer."
5208 (interactive)
5209 (let (input)
5210 (flet ((insert-in-minibuffer (word)
5211 (with-selected-window (minibuffer-window)
5212 (let ((str anything-pattern))
5213 (delete-minibuffer-contents)
5214 (set-text-properties 0 (length word) nil word)
5215 (insert (concat str word))))))
5216 (with-current-buffer anything-current-buffer
5217 ;; Start to initial point if C-w have never been hit.
5218 (unless anything-yank-point (setq anything-yank-point (point)))
5219 (and anything-yank-point (goto-char anything-yank-point))
5220 (forward-word 1)
5221 (setq input (buffer-substring-no-properties anything-yank-point (point)))
5222 (setq anything-yank-point (point))) ; End of last forward-word
5223 (insert-in-minibuffer input))))
5225 (defun anything-reset-yank-point ()
5226 (setq anything-yank-point nil))
5228 (add-hook 'anything-after-persistent-action-hook 'anything-reset-yank-point)
5229 (add-hook 'anything-cleanup-hook 'anything-reset-yank-point)
5230 (define-key anything-map (kbd "C-w") 'anything-yank-text-at-point)
5232 ;;; Etags
5235 ;; anything-etags.el is deprecated, if this file is found,
5236 ;; warn user at compile time.
5237 (eval-when-compile
5238 (when (locate-library "anything-etags.el")
5239 (display-warning
5240 '(anything-config)
5241 "You are using obsolete library `anything-etags.el' and should remove it."
5242 :warning)))
5244 (defvar anything-c-etags-tag-file-dir nil
5245 "Etags file directory.")
5246 (defvar anything-c-etags-mtime-alist nil
5247 "Store the last modification time of etags files here.")
5248 (defvar anything-c-etags-cache (make-hash-table :test 'equal)
5249 "Cache content of etags files used here for faster access.")
5251 (defun anything-c-etags-get-tag-file (&optional directory)
5252 "Return the path of etags file if found."
5253 ;; Get tag file from `default-directory' or upper directory.
5254 (let ((current-dir (anything-c-etags-find-tag-file-directory
5255 (or directory default-directory))))
5256 ;; Return nil if not find tag file.
5257 (when current-dir
5258 ;; Set tag file directory.
5259 (setq anything-c-etags-tag-file-dir current-dir)
5260 (expand-file-name anything-c-etags-tag-file-name current-dir))))
5262 (defun anything-c-etags-find-tag-file-directory (current-dir)
5263 "Try to find the directory containing tag file.
5264 If not found in CURRENT-DIR search in upper directory."
5265 (flet ((file-exists? (dir)
5266 (let ((tag-path (expand-file-name
5267 anything-c-etags-tag-file-name dir)))
5268 (and (stringp tag-path)
5269 (file-exists-p tag-path)
5270 (file-readable-p tag-path)))))
5271 (loop with count = 0
5272 until (file-exists? current-dir)
5273 ;; Return nil if outside the value of
5274 ;; `anything-c-etags-tag-file-search-limit'.
5275 if (= count anything-c-etags-tag-file-search-limit)
5276 do (return nil)
5277 ;; Or search upper directories.
5278 else
5279 do (incf count)
5280 (setq current-dir (expand-file-name (concat current-dir "../")))
5281 finally return current-dir)))
5283 (defun anything-c-source-etags-header-name (x)
5284 "Create header name for this anything etags session."
5285 (concat "Etags in "
5286 (with-current-buffer anything-current-buffer
5287 (anything-c-etags-get-tag-file))))
5289 (defmacro anything-c-etags-create-buffer (file)
5290 "Create the `anything-buffer' based on contents of etags tag FILE."
5291 `(let* ((tag-fname ,file)
5293 (split (with-current-buffer (find-file-noselect tag-fname)
5294 (prog1
5295 (split-string (buffer-string) "\n" 'omit-nulls)
5296 (setq max (line-number-at-pos (point-max)))
5297 (kill-buffer))))
5298 (progress-reporter (make-progress-reporter "Loading tag file..." 0 max)))
5299 (loop
5300 with fname
5301 with cand
5302 for i in split for count from 0
5303 for elm = (unless (string-match "^\x0c" i)
5304 (anything-aif (string-match "\177" i)
5305 (substring i 0 it)
5307 do (cond ((and elm (string-match "^\\(.+\\),[0-9]+" elm))
5308 (setq fname (match-string 1 elm)))
5309 (elm (setq cand (concat fname ": " elm)))
5310 (t (setq cand nil)))
5311 when cand do (progn
5312 (insert (concat cand "\n"))
5313 (progress-reporter-update progress-reporter count)))))
5315 (defun anything-c-etags-init ()
5316 "Feed `anything-buffer' using `anything-c-etags-cache' or tag file.
5317 If no entry in cache, create one."
5318 (let ((tagfile (anything-c-etags-get-tag-file)))
5319 (when tagfile
5320 (with-current-buffer (anything-candidate-buffer 'global)
5321 (anything-aif (gethash tagfile anything-c-etags-cache)
5322 ;; An entry is present in cache, insert it.
5323 (insert it)
5324 ;; No entry, create a new buffer using content of tag file (slower).
5325 (anything-c-etags-create-buffer tagfile)
5326 ;; Store content of buffer in cache.
5327 (puthash tagfile (buffer-string) anything-c-etags-cache)
5328 ;; Store or set the last modification of tag file.
5329 (anything-aif (assoc tagfile anything-c-etags-mtime-alist)
5330 ;; If an entry exists modify it.
5331 (setcdr it (anything-c-etags-mtime tagfile))
5332 ;; No entry create a new one.
5333 (add-to-list 'anything-c-etags-mtime-alist
5334 (cons tagfile (anything-c-etags-mtime tagfile)))))))))
5336 (defvar anything-c-source-etags-select
5337 '((name . "Etags")
5338 (header-name . anything-c-source-etags-header-name)
5339 (init . anything-c-etags-init)
5340 (candidates-in-buffer)
5341 (mode-line . anything-etags-mode-line-string)
5342 (action . anything-c-etags-default-action)
5343 (persistent-action . (lambda (candidate)
5344 (anything-c-etags-default-action candidate)
5345 (anything-match-line-color-current-line))))
5346 "Anything source for Etags.")
5348 (defun anything-c-etags-default-action (candidate)
5349 "Anything default action to jump to an etags entry."
5350 (let* ((split (split-string candidate ": "))
5351 (fname (expand-file-name
5352 (car split) anything-c-etags-tag-file-dir))
5353 (elm (cadr split)))
5354 (find-file fname)
5355 (goto-char (point-min))
5356 (search-forward elm nil t)
5357 (goto-char (match-beginning 0))))
5359 (defun anything-c-etags-select (arg)
5360 "Preconfigured anything for etags.
5361 Called with one prefix arg use symbol at point as initial input.
5362 Called with two prefix arg reinitialize cache.
5363 If tag file have been modified reinitialize cache."
5364 (interactive "P")
5365 (let ((tag (anything-c-etags-get-tag-file))
5366 (init (and (equal arg '(4)) (thing-at-point 'symbol)))
5367 (anything-quit-if-no-candidate t)
5368 (anything-execute-action-at-once-if-one t))
5369 (when (or (equal arg '(16))
5370 (and anything-c-etags-mtime-alist
5371 (anything-c-etags-file-modified-p tag)))
5372 (remhash tag anything-c-etags-cache))
5373 (if (and tag (file-exists-p tag))
5374 (anything :sources 'anything-c-source-etags-select
5375 :keymap anything-c-etags-map
5376 :input init
5377 :buffer "*anything etags*")
5378 (message "Error: No tag file found, please create one with etags shell command."))))
5380 (defun anything-c-etags-mtime (file)
5381 "Last modification time of etags tag FILE."
5382 (cadr (nth 5 (file-attributes file))))
5384 (defun anything-c-etags-file-modified-p (file)
5385 "Check if tag FILE have been modified in this session.
5386 If FILE is nil return nil."
5387 (let ((last-modif (and file
5388 (assoc-default file anything-c-etags-mtime-alist))))
5389 (and last-modif
5390 (/= last-modif (anything-c-etags-mtime file)))))
5392 ;;; Recentf files
5395 (defvar anything-c-source-recentf
5396 '((name . "Recentf")
5397 (init . (lambda ()
5398 (require 'recentf)
5399 (or recentf-mode (recentf-mode 1))
5400 ;; Big value empowers anything/recentf
5401 (when (and (numberp recentf-max-saved-items)
5402 (<= recentf-max-saved-items 20))
5403 (setq recentf-max-saved-items 500))))
5404 (candidates . recentf-list)
5405 (match anything-c-match-on-file-name
5406 anything-c-match-on-directory-name)
5407 (type . file))
5408 "See (info \"(emacs)File Conveniences\").
5409 if `recentf-max-saved-items' is too small, set it to 500.")
5410 ;; (anything 'anything-c-source-recentf)
5412 ;;; ffap
5413 (eval-when-compile (require 'ffap))
5414 (defvar anything-c-source-ffap-guesser
5415 '((name . "File at point")
5416 (init . (lambda () (require 'ffap)))
5417 (candidates . (lambda ()
5418 (anything-aif
5419 (with-current-buffer anything-current-buffer
5420 (ffap-guesser))
5421 (list it))))
5422 (type . file)))
5423 ;; (anything 'anything-c-source-ffap-guesser)
5425 ;;; ffap with line number
5426 (defun anything-c-ffap-file-line-at-point ()
5427 "Get (FILENAME . LINENO) at point."
5428 (anything-aif (let (ffap-alist) (ffap-file-at-point))
5429 (save-excursion
5430 (beginning-of-line)
5431 (when (and (search-forward it nil t)
5432 (looking-at ":\\([0-9]+\\)"))
5433 (cons it (string-to-number (match-string 1)))))))
5435 (defvar anything-c-ffap-line-location nil
5436 "(FILENAME . LINENO) used by `anything-c-source-ffap-line'.
5437 It is cleared after jumping line.")
5439 (defun anything-c-ffap-line-candidates ()
5440 (with-current-buffer anything-current-buffer
5441 (setq anything-c-ffap-line-location (anything-c-ffap-file-line-at-point)))
5442 (when anything-c-ffap-line-location
5443 (destructuring-bind (file . line) anything-c-ffap-line-location
5444 (list (cons (format "%s (line %d)" file line) file)))))
5446 ;;; Goto line after opening file by `anything-c-source-ffap-line'.
5447 (defun anything-c-ffap-line-goto-line ()
5448 (when (car anything-c-ffap-line-location)
5449 (unwind-protect
5450 (ignore-errors
5451 (with-selected-window
5452 (get-buffer-window
5453 (get-file-buffer (car anything-c-ffap-line-location)))
5454 (anything-goto-line (cdr anything-c-ffap-line-location)))))))
5455 (add-hook 'anything-after-action-hook 'anything-c-ffap-line-goto-line)
5456 (add-hook 'anything-after-persistent-action-hook 'anything-c-ffap-line-goto-line)
5458 (defvar anything-c-source-ffap-line
5459 '((name . "File/Lineno at point")
5460 (init . (lambda () (require 'ffap)))
5461 (candidates . anything-c-ffap-line-candidates)
5462 (type . file)))
5463 ;; (anything 'anything-c-source-ffap-line)
5465 ;;; list of files gleaned from every dired buffer
5466 (defun anything-c-files-in-all-dired-candidates ()
5467 (save-excursion
5468 (mapcan
5469 (lambda (dir)
5470 (cond ((listp dir) ;filelist
5471 dir)
5472 ((equal "" (file-name-nondirectory dir)) ;dir
5473 (directory-files dir t))
5474 (t ;wildcard
5475 (file-expand-wildcards dir t))))
5476 (delq nil
5477 (mapcar (lambda (buf)
5478 (set-buffer buf)
5479 (when (eq major-mode 'dired-mode)
5480 (if (consp dired-directory)
5481 (cdr dired-directory) ;filelist
5482 dired-directory))) ;dir or wildcard
5483 (buffer-list))))))
5484 ;; (dired '("~/" "~/.emacs-custom.el" "~/.emacs.bmk"))
5486 (defvar anything-c-source-files-in-all-dired
5487 '((name . "Files in all dired buffer.")
5488 (candidates . anything-c-files-in-all-dired-candidates)
5489 (type . file)))
5490 ;; (anything 'anything-c-source-files-in-all-dired)
5492 (defvar anything-c-source-filelist
5493 '((name . "FileList")
5494 (grep-candidates . anything-c-filelist-file-name)
5495 (candidate-number-limit . 200)
5496 (requires-pattern . 4)
5497 (type . file))
5498 "Source to find files instantly.
5499 See `anything-c-filelist-file-name' docstring for usage.")
5501 ;;;###autoload
5502 (defun anything-filelist ()
5503 "Preconfigured `anything' to open files instantly.
5505 See `anything-c-filelist-file-name' docstring for usage."
5506 (interactive)
5507 (anything-other-buffer 'anything-c-source-filelist "*anything file list*"))
5509 ;;;###autoload
5510 (defun anything-filelist+ ()
5511 "Preconfigured `anything' to open files/buffers/bookmarks instantly.
5513 This is a replacement for `anything-for-files'.
5514 See `anything-c-filelist-file-name' docstring for usage."
5515 (interactive)
5516 (anything-other-buffer
5517 '(anything-c-source-ffap-line
5518 anything-c-source-ffap-guesser
5519 anything-c-source-buffers-list
5520 anything-c-source-recentf
5521 anything-c-source-bookmarks
5522 anything-c-source-file-cache
5523 anything-c-source-filelist)
5524 "*anything file list*"))
5527 ;;;; <info>
5528 ;;; Info pages
5529 (defvar anything-c-info-pages nil
5530 "All info pages on system.
5531 Will be calculated the first time you invoke anything with this
5532 source.")
5534 (defvar anything-c-source-info-pages
5535 `((name . "Info Pages")
5536 (candidates
5537 . (lambda ()
5538 (if anything-c-info-pages
5539 anything-c-info-pages
5540 (setq anything-c-info-pages
5541 (save-window-excursion
5542 (save-excursion
5543 (require 'info)
5544 (Info-find-node "dir" "top")
5545 (goto-char (point-min))
5546 (let ((info-topic-regexp "\\* +\\([^:]+: ([^)]+)[^.]*\\)\\.")
5547 topics)
5548 (while (re-search-forward info-topic-regexp nil t)
5549 (add-to-list 'topics (match-string-no-properties 1)))
5550 (goto-char (point-min))
5551 (Info-exit)
5552 topics)))))))
5553 (action . (("Show with Info" .(lambda (node-str)
5554 (info (replace-regexp-in-string
5555 "^[^:]+: " "" node-str))))))
5556 (requires-pattern . 2)))
5557 ;; (anything 'anything-c-source-info-pages)
5560 ;; FIXME should be merged in anything.el with `anything-describe-anything-attribute'.
5561 (defun anything-c-describe-attributes (anything-attribute)
5562 "Display the full documentation of ANYTHING-ATTRIBUTE (a symbol).
5563 Same as `anything-describe-anything-attribute' but with anything completion."
5564 (interactive (list (intern
5565 (anything-comp-read
5566 "Describe anything attribute: "
5567 (mapcar 'symbol-name anything-additional-attributes)
5568 :must-match t
5569 :persistent-action
5570 #'(lambda (candidate)
5571 (with-output-to-temp-buffer "*Help*"
5572 (princ (get (intern candidate) 'anything-attrdoc))))))))
5573 (with-output-to-temp-buffer "*Help*"
5574 (princ (get anything-attribute 'anything-attrdoc))))
5576 ;;; Use info-index plug-in.
5579 ;; Note that `name' attribute is not needed since
5580 ;; `anything-c-insert-summary' have been removed.
5581 ;; Info Elisp
5582 (defvar anything-c-source-info-elisp
5583 '((name . "Info index: elisp")
5584 (info-index . "elisp")))
5585 ;; (anything 'anything-c-source-info-elisp)
5587 ;; Info-Common-Lisp
5588 (defvar anything-c-source-info-cl
5589 '((name . "Info index: cl")
5590 (info-index . "cl")))
5591 ;; (anything 'anything-c-source-info-cl)
5593 ;; Info Index org
5594 (defvar anything-c-source-info-org
5595 '((name . "Info index: org")
5596 (info-index . "org")))
5597 ;; (anything 'anything-c-source-info-org)
5599 ;; Info Index gnus
5600 (defvar anything-c-source-info-gnus
5601 '((name . "Info index: Gnus")
5602 (info-index . "gnus")))
5604 ;; Info Index ratpoison
5605 (defvar anything-c-source-info-ratpoison
5606 '((name . "Info index: ratpoison")
5607 (info-index . "ratpoison")))
5608 ;; (anything 'anything-c-source-info-ratpoison)
5610 ;; Info Index zsh
5611 (defvar anything-c-source-info-zsh
5612 '((name . "Info index: zsh")
5613 (info-index . "zsh")))
5614 ;; (anything 'anything-c-source-info-zsh)
5616 ;; Info Index bash
5617 (defvar anything-c-source-info-bash
5618 '((name . "Info index: bash")
5619 (info-index . "bash")))
5620 ;; (anything 'anything-c-source-info-bash)
5622 ;; Info Index coreutils
5623 (defvar anything-c-source-info-coreutils
5624 '((name . "Info index: coreutils")
5625 (info-index . "coreutils")))
5626 ;; (anything 'anything-c-source-info-coreutils)
5628 ;; Info Index fileutils
5629 (defvar anything-c-source-info-fileutils
5630 '((name . "Info index: fileutils")
5631 (info-index . "fileutils")))
5632 ;; (anything 'anything-c-source-info-fileutils)
5634 ;; Info Index find
5635 (defvar anything-c-source-info-find
5636 '((name . "Info index: find")
5637 (info-index . "find")))
5638 ;; (anything 'anything-c-source-info-find)
5640 ;; Info Index sh-utils
5641 (defvar anything-c-source-info-sh-utils
5642 '((name . "Info index: sh-utils")
5643 (info-index . "sh-utils")))
5644 ;; (anything 'anything-c-source-info-sh-utils)
5646 ;; Info Index textutils
5647 (defvar anything-c-source-info-textutils
5648 '((name . "Info index: textutils")
5649 (info-index . "textutils")))
5650 ;; (anything 'anything-c-source-info-textutils)
5652 ;; Info Index libc
5653 (defvar anything-c-source-info-libc
5654 '((name . "Info index: libc")
5655 (info-index . "libc")))
5656 ;; (anything 'anything-c-source-info-libc)
5658 ;; Info Index make
5659 (defvar anything-c-source-info-make
5660 '((name . "Info index: make")
5661 (info-index . "make")))
5662 ;; (anything 'anything-c-source-info-make)
5664 ;; Info Index automake
5665 (defvar anything-c-source-info-automake
5666 '((name . "Info index: automake")
5667 (info-index . "automake")))
5668 ;; (anything 'anything-c-source-info-automake)
5670 ;; Info Index autoconf
5671 (defvar anything-c-source-info-autoconf
5672 '((name . "Info index: autoconf")
5673 (info-index . "autoconf")))
5674 ;; (anything 'anything-c-source-info-autoconf)
5676 ;; Info Index emacs-lisp-intro
5677 (defvar anything-c-source-info-emacs-lisp-intro
5678 '((name . "Info index: emacs-lisp-intro")
5679 (info-index . "emacs-lisp-intro")))
5680 ;; (anything 'anything-c-source-info-emacs-lisp-intro)
5682 ;; Info Index emacs
5683 (defvar anything-c-source-info-emacs
5684 '((name . "Info index: emacs")
5685 (info-index . "emacs")))
5686 ;; (anything 'anything-c-source-info-emacs)
5688 ;; Info Index elib
5689 (defvar anything-c-source-info-elib
5690 '((name . "Info index: elib")
5691 (info-index . "elib")))
5692 ;; (anything 'anything-c-source-info-elib)
5694 ;; Info Index eieio
5695 (defvar anything-c-source-info-eieio
5696 '((name . "Info index: eieio")
5697 (info-index . "eieio")))
5698 ;; (anything 'anything-c-source-info-eieio)
5700 ;; Info Index gauche-refe
5701 (defvar anything-c-source-info-gauche-refe
5702 '((name . "Info index: gauche")
5703 (info-index . "gauche-refe")))
5704 ;; (anything 'anything-c-source-info-gauche-refe)
5706 ;; Info Index guile
5707 (defvar anything-c-source-info-guile
5708 '((name . "Info index: guile")
5709 (info-index . "guile")))
5710 ;; (anything 'anything-c-source-info-guile)
5712 ;; Info Index guile-tut
5713 (defvar anything-c-source-info-guile-tut
5714 '((name . "Info index: guile-tut")
5715 (info-index . "guile-tut")))
5716 ;; (anything 'anything-c-source-info-guile-tut)
5718 ;; Info Index goops
5719 (defvar anything-c-source-info-goops
5720 '((name . "Info index: goops")
5721 (info-index . "goops")))
5722 ;; (anything 'anything-c-source-info-goops)
5724 ;; Info Index screen
5725 (defvar anything-c-source-info-screen
5726 '((name . "Info index: screen")
5727 (info-index . "screen")
5728 (index-nodes "Concept Index" "Command Index" "Keystroke Index")))
5729 ;; (anything 'anything-c-source-info-screen)
5731 ;; Info Index latex
5732 (defvar anything-c-source-info-latex
5733 '((name . "Info index: latex")
5734 (info-index . "latex")))
5735 ;; (anything 'anything-c-source-info-latex)
5737 ;; Info Index gawk
5738 (defvar anything-c-source-info-gawk
5739 '((name . "Info index: gawk")
5740 (info-index . "gawk")))
5741 ;; (anything 'anything-c-source-info-gawk)
5743 ;; Info Index sed
5744 (defvar anything-c-source-info-sed
5745 '((name . "Info index: sed")
5746 (info-index . "sed")))
5747 ;; (anything 'anything-c-source-info-sed)
5749 ;; Info Index m4
5750 (defvar anything-c-source-info-m4
5751 '((name . "Info index: m4")
5752 (info-index . "m4")))
5753 ;; (anything 'anything-c-source-info-m4)
5755 ;; Info Index wget
5756 (defvar anything-c-source-info-wget
5757 '((name . "Info index: wget")
5758 (info-index . "wget")))
5759 ;; (anything 'anything-c-source-info-wget)
5761 ;; Info Index binutils
5762 (defvar anything-c-source-info-binutils
5763 '((name . "Info index: binutils")
5764 (info-index . "binutils")))
5765 ;; (anything 'anything-c-source-info-binutils)
5767 ;; Info Index as
5768 (defvar anything-c-source-info-as
5769 '((name . "Info index: as")
5770 (info-index . "as")))
5771 ;; (anything 'anything-c-source-info-as)
5773 ;; Info Index bfd
5774 (defvar anything-c-source-info-bfd
5775 '((name . "Info index: bfd")
5776 (info-index . "bfd")))
5777 ;; (anything 'anything-c-source-info-bfd)
5779 ;; Info Index gprof
5780 (defvar anything-c-source-info-gprof
5781 '((name . "Info index: gprof")
5782 (info-index . "gprof")))
5783 ;; (anything 'anything-c-source-info-gprof)
5785 ;; Info Index ld
5786 (defvar anything-c-source-info-ld
5787 '((name . "Info index: ld")
5788 (info-index . "ld")))
5789 ;; (anything 'anything-c-source-info-ld)
5791 ;; Info Index diff
5792 (defvar anything-c-source-info-diff
5793 '((name . "Info index: diff")
5794 (info-index . "diff")))
5795 ;; (anything 'anything-c-source-info-diff)
5797 ;; Info Index flex
5798 (defvar anything-c-source-info-flex
5799 '((name . "Info index: flex")
5800 (info-index . "flex")))
5801 ;; (anything 'anything-c-source-info-flex)
5803 ;; Info Index grep
5804 (defvar anything-c-source-info-grep
5805 '((name . "Info index: grep")
5806 (info-index . "grep")))
5807 ;; (anything 'anything-c-source-info-grep)
5809 ;; Info Index gzip
5810 (defvar anything-c-source-info-gzip
5811 '((name . "Info index: gzip")
5812 (info-index . "gzip")))
5813 ;; (anything 'anything-c-source-info-gzip)
5815 ;; Info Index libtool
5816 (defvar anything-c-source-info-libtool
5817 '((name . "Info index: libtool")
5818 (info-index . "libtool")))
5819 ;; (anything 'anything-c-source-info-libtool)
5821 ;; Info Index texinfo
5822 (defvar anything-c-source-info-texinfo
5823 '((name . "Info index: texinfo")
5824 (info-index . "texinfo")))
5825 ;; (anything 'anything-c-source-info-texinfo)
5827 ;; Info Index info
5828 (defvar anything-c-source-info-info
5829 '((name . "Info index: info")
5830 (info-index . "info")))
5831 ;; (anything 'anything-c-source-info-info)
5833 ;; Info Index gdb
5834 (defvar anything-c-source-info-gdb
5835 '((name . "Info index: gdb")
5836 (info-index . "gdb")))
5837 ;; (anything 'anything-c-source-info-gdb)
5839 ;; Info Index stabs
5840 (defvar anything-c-source-info-stabs
5841 '((name . "Info index: stabs")
5842 (info-index . "stabs")))
5843 ;; (anything 'anything-c-source-info-stabs)
5845 ;; Info Index cvsbook
5846 (defvar anything-c-source-info-cvsbook
5847 '((name . "Info index: cvsbook")
5848 (info-index . "cvsbook")))
5849 ;; (anything 'anything-c-source-info-cvsbook)
5851 ;; Info Index cvs
5852 (defvar anything-c-source-info-cvs
5853 '((name . "Info index: cvs")
5854 (info-index . "cvs")))
5855 ;; (anything 'anything-c-source-info-cvs)
5857 ;; Info Index bison
5858 (defvar anything-c-source-info-bison
5859 '((name . "Info index: bison")
5860 (info-index . "bison")))
5861 ;; (anything 'anything-c-source-info-bison)
5863 ;; Info Index id-utils
5864 (defvar anything-c-source-info-id-utils
5865 '((name . "Info index: id-utils")
5866 (info-index . "id-utils")))
5867 ;; (anything 'anything-c-source-info-id-utils)
5869 ;; Info Index global
5870 (defvar anything-c-source-info-global
5871 '((name . "Info index: global")
5872 (info-index . "global")))
5873 ;; (anything 'anything-c-source-info-global)
5875 ;;;; <Help>
5876 ;;; Man Pages
5877 (defvar anything-c-man-pages nil
5878 "All man pages on system.
5879 Will be calculated the first time you invoke anything with this
5880 source.")
5882 (defun anything-c-man-default-action (candidate)
5883 "Default action for jumping to a woman or man page from anything."
5884 (let ((wfiles (woman-file-name-all-completions candidate)))
5885 (condition-case err
5886 (if (> (length wfiles) 1)
5887 (woman-find-file
5888 (anything-comp-read
5889 "ManFile: " wfiles :must-match t))
5890 (woman candidate))
5891 ;; If woman is unable to format correctly
5892 ;; use man instead.
5893 (error (kill-buffer) ; Kill woman buffer.
5894 (let ((Man-notify-method 'meek))
5895 (Man-getpage-in-background candidate))))))
5897 (defvar anything-c-source-man-pages
5898 `((name . "Manual Pages")
5899 (candidates . (lambda ()
5900 (if anything-c-man-pages
5901 anything-c-man-pages
5902 ;; XEmacs doesn't have a woman :)
5903 (setq anything-c-man-pages
5904 (ignore-errors
5905 (require 'woman)
5906 (woman-file-name "")
5907 (sort (mapcar 'car woman-topic-all-completions)
5908 'string-lessp))))))
5909 (action ("Show with Woman" . anything-c-man-default-action))
5910 ;; Woman does not work OS X
5911 ;; http://xahlee.org/emacs/modernization_man_page.html
5912 (action-transformer . (lambda (actions candidate)
5913 (if (eq system-type 'darwin)
5914 '(("Show with Man" . man))
5915 actions)))
5916 (requires-pattern . 2)))
5917 ;; (anything 'anything-c-source-man-pages)
5919 ;;;; <Command>
5920 ;;; Complex command history
5921 (defvar anything-c-source-complex-command-history
5922 '((name . "Complex Command History")
5923 (candidates . (lambda () (mapcar 'prin1-to-string command-history)))
5924 (type . sexp)))
5925 ;; (anything 'anything-c-source-complex-command-history)
5927 ;;; M-x history
5928 (defvar anything-c-source-extended-command-history
5929 '((name . "Emacs Commands History")
5930 (candidates . extended-command-history)
5931 (type . command)))
5932 ;; (anything 'anything-c-source-extended-command-history)
5934 ;;; Emacs commands
5935 (defvar anything-c-source-emacs-commands
5936 '((name . "Emacs Commands")
5937 (candidates . (lambda ()
5938 (let (commands)
5939 (mapatoms (lambda (a)
5940 (if (commandp a)
5941 (push (symbol-name a)
5942 commands))))
5943 (sort commands 'string-lessp))))
5944 (type . command)
5945 (requires-pattern . 2))
5946 "Source for completing and invoking Emacs commands.
5947 A command is a function with interactive spec that can
5948 be invoked with `M-x'.
5950 To get non-interactive functions listed, use
5951 `anything-c-source-emacs-functions'.")
5952 ;; (anything 'anything-c-source-emacs-commands)
5954 ;;; Anything M-x
5956 ;; Another replacement of `M-x' that act exactly like the
5957 ;; vanilla Emacs one, no problem of windows configuration, prefix args
5958 ;; can be passed before calling `M-x' (e.g C-u M-x..) but also during
5959 ;; anything invocation.
5960 ;;;###autoload
5961 (defun anything-M-x ()
5962 "Preconfigured `anything' for Emacs commands.
5963 It is `anything' replacement of regular `M-x' `execute-extended-command'."
5964 (interactive)
5965 (let* (in-help
5966 help-cand
5967 anything-persistent-action-use-special-display
5968 (history (loop with hist
5969 for i in extended-command-history
5970 for com = (intern i)
5971 when (and (fboundp com) (not (member i hist)))
5972 collect i into hist finally return hist))
5973 (command (anything-comp-read
5974 "M-x " obarray
5975 :test 'commandp
5976 :must-match t
5977 :requires-pattern 2
5978 :name "Emacs Commands"
5979 :persistent-action
5980 #'(lambda (candidate)
5981 (let ((hbuf (get-buffer (help-buffer))))
5982 (if (and in-help (string= candidate help-cand))
5983 (progn
5984 ;; When M-x is started from a help buffer,
5985 ;; Don't kill it as it is anything-current-buffer.
5986 (unless (equal hbuf anything-current-buffer)
5987 (kill-buffer hbuf))
5988 (setq in-help nil))
5989 ;; Be sure anything-current-buffer have not a dedicated window.
5990 (set-window-dedicated-p
5991 (get-buffer-window anything-current-buffer) nil)
5992 (describe-function (intern candidate))
5993 (message nil) ; Erase the new stupid message Type "q"[...]
5994 (setq in-help t))
5995 (setq help-cand candidate)))
5996 :persistent-help "Describe this command"
5997 :history history
5998 :sort 'string-lessp
5999 :fc-transformer 'anything-M-x-transformer)))
6000 (unless current-prefix-arg (setq current-prefix-arg anything-current-prefix-arg))
6001 (call-interactively (intern command))
6002 (setq extended-command-history (cons command (delete command history)))))
6004 (defun* anything-M-x-get-major-mode-command-alist (mode-map)
6005 "Return alist of MODE-MAP."
6006 (loop for key being the key-seqs of mode-map using (key-bindings com)
6007 for str-key = (key-description key)
6008 for ismenu = (string-match "<menu-bar>" str-key)
6009 unless ismenu collect (cons str-key com)))
6011 (defun anything-get-mode-map-from-mode (mode)
6012 "Guess the mode-map name according to MODE.
6013 Some modes don't use conventional mode-map name
6014 so we need to guess mode-map name. e.g python-mode ==> py-mode-map.
6015 Return nil if no mode-map found."
6016 (loop
6017 ;; Start with a conventional mode-map name.
6018 with mode-map = (intern-soft (format "%s-map" mode))
6019 with mode-string = (symbol-name mode)
6020 with mode-name = (replace-regexp-in-string "-mode" "" mode-string)
6021 while (not mode-map)
6022 for count downfrom (length mode-name)
6023 ;; Return when no result after parsing entire string.
6024 when (eq count 0) return nil
6025 for sub-name = (substring mode-name 0 count)
6026 do (setq mode-map (intern-soft (format "%s-map" (concat sub-name "-mode"))))
6027 finally return mode-map))
6029 (defun anything-M-x-current-mode-map-alist ()
6030 "Return mode-map alist of current `major-mode'."
6031 (let ((map (anything-get-mode-map-from-mode major-mode)))
6032 (when (and map (boundp map))
6033 (anything-M-x-get-major-mode-command-alist (symbol-value map)))))
6036 (defun anything-M-x-transformer (candidates sources)
6037 "filtered-candidate-transformer to show bindings in emacs commands.
6038 Show global bindings and local bindings according to current `major-mode'."
6039 (with-current-buffer anything-current-buffer
6040 (loop
6041 with local-map = (anything-M-x-current-mode-map-alist)
6042 for cand in candidates
6043 for local-key = (car (rassq cand local-map))
6044 for key = (substitute-command-keys (format "\\[%s]" cand))
6045 collect
6046 (cons (cond ((and (string-match "^M-x" key) local-key)
6047 (format "%s (%s)"
6048 cand (propertize
6049 local-key
6050 'face 'anything-M-x-key-face)))
6051 ((string-match "^M-x" key) cand)
6052 (t (format "%s (%s)"
6053 cand (propertize
6055 'face 'anything-M-x-key-face)))) cand))))
6057 ;;; LaCarte
6058 (defvar anything-c-source-lacarte
6059 '((name . "Lacarte")
6060 (init . (lambda () (require 'lacarte )))
6061 (candidates . (lambda () (delete '(nil) (lacarte-get-overall-menu-item-alist))))
6062 (candidate-number-limit . 9999)
6063 (action . anything-c-call-interactively))
6064 "Needs lacarte.el.
6066 http://www.emacswiki.org/cgi-bin/wiki/download/lacarte.el")
6067 ;; (anything 'anything-c-source-lacarte)
6069 ;;;; <Function>
6070 ;;; Emacs functions
6071 (defvar anything-c-source-emacs-functions
6072 '((name . "Emacs Functions")
6073 (candidates . (lambda ()
6074 (let (commands)
6075 (mapatoms (lambda (a)
6076 (if (functionp a)
6077 (push (symbol-name a) commands))))
6078 (sort commands 'string-lessp))))
6079 (type . function)
6080 (requires-pattern . 2))
6081 "Source for completing Emacs functions.")
6082 ;; (anything 'anything-c-source-emacs-functions)
6084 ;;; With abbrev expansion
6085 ;;; Similar to my exec-abbrev-cmd.el
6086 ;;; See http://www.tsdh.de/cgi-bin/wiki.pl/exec-abbrev-cmd.el
6087 (defvar anything-c-function-abbrev-regexp nil
6088 "The regexp for `anything-c-source-emacs-functions-with-abbrevs'.
6089 Regexp built from the current `anything-pattern' interpreting it
6090 as abbreviation.
6091 Only for internal use.")
6093 (defun anything-c-match-function-by-abbrev (candidate)
6094 "Return non-nil if `anything-pattern' is an abbreviation of the function CANDIDATE.
6096 Abbreviations are made by taking the first character from each
6097 word in the function's name, e.g. \"bb\" is an abbrev for
6098 `bury-buffer', \"stb\" is an abbrev for `anything-c-switch-to-buffer'."
6099 (string-match anything-c-function-abbrev-regexp candidate))
6101 (defvar anything-c-source-emacs-functions-with-abbrevs
6102 (append anything-c-source-emacs-functions
6103 '((match anything-c-match-function-by-abbrev
6104 anything-c-string-match))
6105 '((init
6106 . (lambda ()
6107 (defadvice anything-update
6108 (before anything-c-update-function-abbrev-regexp activate)
6109 (let ((char-list (append anything-pattern nil))
6110 (str "^"))
6111 (dolist (c char-list)
6112 (setq str (concat str (list c) "[^-]*-")))
6113 (setq str (concat (substring str 0 (1- (length str))) "$"))
6114 (setq anything-c-function-abbrev-regexp str))))))))
6115 ;; (anything 'anything-c-source-emacs-functions-with-abbrevs)
6117 (defvar anything-c-source-advice
6118 '((name . "Function Advice")
6119 (candidates . anything-c-advice-candidates)
6120 (action ("Toggle Enable/Disable" . anything-c-advice-toggle))
6121 ;; (real-to-display . anything-c-advice-real-to-display)
6122 (persistent-action . anything-c-advice-persistent-action)
6123 (persistent-help . "Describe function / C-u C-z: Toggle advice")))
6124 ;; (anything 'anything-c-source-advice)
6125 ;; (let ((debug-on-signal t))(anything 'anything-c-source-advice))
6126 ;; (testadvice)
6128 (defun anything-c-advice-candidates ()
6129 (require 'advice)
6130 (loop for (fname) in ad-advised-functions
6131 for function = (intern fname)
6132 append
6133 (loop for class in ad-advice-classes append
6134 (loop for advice in (ad-get-advice-info-field function class)
6135 for enabled = (ad-advice-enabled advice)
6136 collect
6137 (cons (format
6138 "%s %s %s"
6139 (if enabled "Enabled " "Disabled")
6140 (propertize fname 'face 'font-lock-function-name-face)
6141 (ad-make-single-advice-docstring advice class nil))
6142 (list function class advice))))))
6144 (defun anything-c-advice-persistent-action (func-class-advice)
6145 (if current-prefix-arg
6146 (anything-c-advice-toggle func-class-advice)
6147 (describe-function (car func-class-advice))))
6149 (defun anything-c-advice-toggle (func-class-advice)
6150 (destructuring-bind (function class advice) func-class-advice
6151 (cond ((ad-advice-enabled advice)
6152 (ad-advice-set-enabled advice nil)
6153 (message "Disabled"))
6154 (t ;disabled
6155 (ad-advice-set-enabled advice t)
6156 (message "Enabled")))
6157 (ad-activate function)
6158 (and anything-in-persistent-action
6159 (anything-c-advice-update-current-display-string))))
6161 (defun anything-c-advice-update-current-display-string ()
6162 (anything-edit-current-selection
6163 (let ((newword (cond ((looking-at "Disabled") "Enabled")
6164 ((looking-at "Enabled") "Disabled")))
6165 realvalue)
6166 (when newword
6167 (delete-region (point) (progn (forward-word 1) (point)))
6168 (insert newword)))))
6170 ;;;###autoload
6171 (defun anything-manage-advice ()
6172 "Preconfigured `anything' to disable/enable function advices."
6173 (interactive)
6174 (anything-other-buffer 'anything-c-source-advice "*anything advice*"))
6176 ;;;; <Variable>
6177 ;;; Emacs variables
6178 (defvar anything-c-source-emacs-variables
6179 '((name . "Emacs Variables")
6180 (candidates . (lambda ()
6181 (sort (all-completions "" obarray 'boundp) 'string-lessp)))
6182 (type . variable)
6183 (requires-pattern . 2))
6184 "Source for completing Emacs variables.")
6185 ;; (anything 'anything-c-source-emacs-variables)
6187 ;;; Bookmarks
6190 ;; Bind some faces for bookmarks.
6191 (defvar anything-c-bookmarks-face1 'anything-ff-directory)
6192 (defvar anything-c-bookmarks-face2 'anything-ff-file)
6193 (defvar anything-c-bookmarks-face3 'anything-bookmarks-su-face)
6195 (eval-when-compile (require 'bookmark))
6196 (defvar anything-c-source-bookmarks
6197 '((name . "Bookmarks")
6198 (init . (lambda ()
6199 (require 'bookmark)))
6200 (candidates . bookmark-all-names)
6201 (type . bookmark))
6202 "See (info \"(emacs)Bookmarks\").")
6203 ;; (anything 'anything-c-source-bookmarks)
6205 ;;; bookmark-set
6206 (defvar anything-c-source-bookmark-set
6207 '((name . "Set Bookmark")
6208 (dummy)
6209 (action . bookmark-set))
6210 "See (info \"(emacs)Bookmarks\").")
6211 ;; (anything 'anything-c-source-bookmark-set)
6213 ;;; Visible Bookmarks
6214 ;; (install-elisp "http://cvs.savannah.gnu.org/viewvc/*checkout*/bm/bm/bm.el")
6217 ;; http://d.hatena.ne.jp/grandVin/20080911/1221114327
6218 (defvar anything-c-source-bm
6219 '((name . "Visible Bookmarks")
6220 (init . anything-c-bm-init)
6221 (candidates-in-buffer)
6222 (type . line))
6223 "Needs bm.el.
6225 http://www.nongnu.org/bm/")
6227 (defun anything-c-bm-init ()
6228 "Init function for `anything-c-source-bm'."
6229 (when (require 'bm nil t)
6230 (with-no-warnings
6231 (let ((bookmarks (bm-lists))
6232 (buf (anything-candidate-buffer 'global)))
6233 (dolist (bm (sort* (append (car bookmarks) (cdr bookmarks))
6234 '< :key 'overlay-start))
6235 (let ((start (overlay-start bm))
6236 (end (overlay-end bm))
6237 (annotation (or (overlay-get bm 'annotation) "")))
6238 (unless (< (- end start) 1) ; org => (if (< (- end start) 2)
6239 (let ((str (format "%5d: [%s]: %s\n"
6240 (line-number-at-pos start)
6241 annotation
6242 (buffer-substring start (1- end)))))
6243 (with-current-buffer buf (insert str))))))))))
6245 ;;; Special bookmarks
6246 (defvar anything-c-source-bookmarks-ssh
6247 '((name . "Bookmarks-ssh")
6248 (init . (lambda ()
6249 (require 'bookmark)))
6250 (candidates . (lambda () (anything-c-collect-bookmarks :ssh t)))
6251 (type . bookmark))
6252 "See (info \"(emacs)Bookmarks\").")
6253 ;; (anything 'anything-c-source-bookmarks-ssh)
6255 (defvar anything-c-source-bookmarks-su
6256 '((name . "Bookmarks-root")
6257 (init . (lambda ()
6258 (require 'bookmark)))
6259 (candidates . (lambda () (anything-c-collect-bookmarks :su t)))
6260 (filtered-candidate-transformer anything-c-highlight-bookmark-su)
6262 (type . bookmark))
6263 "See (info \"(emacs)Bookmarks\").")
6264 ;; (anything 'anything-c-source-bookmarks-su)
6266 (defvar anything-c-source-bookmarks-local
6267 '((name . "Bookmarks-Local")
6268 (init . (lambda ()
6269 (require 'bookmark)))
6270 (candidates . (lambda () (anything-c-collect-bookmarks :local t)))
6271 (filtered-candidate-transformer
6272 anything-c-adaptive-sort
6273 anything-c-highlight-bookmark)
6274 (type . bookmark))
6275 "See (info \"(emacs)Bookmarks\").")
6276 ;; (anything 'anything-c-source-bookmarks-local)
6278 (defun* anything-c-collect-bookmarks (&key local su sudo ssh)
6279 (let* ((lis-all (bookmark-all-names))
6280 (lis-loc (cond (local (loop for i in lis-all
6281 unless (string-match "^(ssh)\\|^(su)" i)
6282 collect i))
6283 (su (loop for i in lis-all
6284 when (string-match "^(su)" i)
6285 collect i))
6286 (sudo (loop for i in lis-all
6287 when (string-match "^(sudo)" i)
6288 collect i))
6289 (ssh (loop for i in lis-all
6290 when (string-match "^(ssh)" i)
6291 collect i)))))
6292 (sort lis-loc 'string-lessp)))
6294 (defun anything-c-bookmark-root-logged-p ()
6295 (catch 'break
6296 (dolist (i (mapcar #'buffer-name (buffer-list)))
6297 (when (string-match (format "*tramp/%s ." anything-su-or-sudo) i)
6298 (throw 'break t)))))
6300 (defun anything-c-highlight-bookmark-su (files source)
6301 (if (anything-c-bookmark-root-logged-p)
6302 (anything-c-highlight-bookmark files source)
6303 (anything-c-highlight-not-logged files source)))
6305 (defun anything-c-highlight-not-logged (files source)
6306 (loop for i in files
6307 collect (propertize i 'face anything-c-bookmarks-face3)))
6309 (defun anything-c-highlight-bookmark (bookmarks source)
6310 "Used as `candidate-transformer' to colorize bookmarks.
6311 Work both with standard Emacs bookmarks and bookmark-extensions.el."
6312 (loop for i in bookmarks
6313 for isfile = (bookmark-get-filename i)
6314 for bufp = (and (fboundp 'bmkext-get-buffer-name)
6315 (bmkext-get-buffer-name i))
6316 for handlerp = (and (fboundp 'bookmark-get-handler)
6317 (bookmark-get-handler i))
6318 for isw3m = (and (fboundp 'bmkext-w3m-bookmark-p)
6319 (bmkext-w3m-bookmark-p i))
6320 for isgnus = (and (fboundp 'bmkext-gnus-bookmark-p)
6321 (bmkext-gnus-bookmark-p i))
6322 for isman = (and (fboundp 'bmkext-man-bookmark-p) ; Man
6323 (bmkext-man-bookmark-p i))
6324 for iswoman = (and (fboundp 'bmkext-woman-bookmark-p) ; Woman
6325 (bmkext-woman-bookmark-p i))
6326 for handlerp = (bookmark-get-handler i)
6327 for isannotation = (bookmark-get-annotation i)
6328 for isabook = (string= (bookmark-prop-get i 'type) "addressbook")
6329 for isinfo = (eq handlerp 'Info-bookmark-jump)
6330 ;; Add a * if bookmark have annotation
6331 if (and isannotation (not (string-equal isannotation "")))
6332 do (setq i (concat "*" i))
6333 collect (cond (;; info buffers
6334 isinfo
6335 (propertize i 'face 'anything-bmkext-info 'help-echo isfile))
6336 (;; w3m buffers
6337 isw3m
6338 (propertize i 'face 'anything-bmkext-w3m 'help-echo isfile))
6339 (;; gnus buffers
6340 isgnus
6341 (propertize i 'face 'anything-bmkext-gnus 'help-echo isfile))
6342 (;; Man Woman
6343 (or iswoman isman)
6344 (propertize i 'face 'anything-bmkext-man 'help-echo isfile))
6345 (;; Addressbook
6346 isabook
6347 (propertize i 'face '((:foreground "Tomato"))))
6348 (;; directories
6349 (and isfile (file-directory-p isfile))
6350 (propertize i 'face anything-c-bookmarks-face1 'help-echo isfile))
6351 (;; regular files
6353 (propertize i 'face 'anything-bmkext-file 'help-echo isfile)))))
6356 ;;; Sources to filter bookmark-extensions bookmarks.
6359 ;; Dependency: http://mercurial.intuxication.org/hg/emacs-bookmark-extension
6360 ;; If you want to enable google-maps in addressbook you will need
6361 ;; Julien Danjou google-maps-el package available here:
6362 ;; http://julien.danjou.info/google-maps-el.html
6364 (defun anything-c-bmkext-filter-setup-alist (fn &rest args)
6365 "Return a filtered `bookmark-alist' sorted alphabetically."
6366 (loop
6367 with alist = (if args
6368 (apply #'(lambda (x) (funcall fn x)) args)
6369 (funcall fn))
6370 for i in alist
6371 for b = (car i)
6372 collect b into sa
6373 finally return (sort sa 'string-lessp)))
6375 ;;; Addressbook.
6378 (defvar anything-c-source-bmkext-addressbook
6379 '((name . "Bookmark Addressbook")
6380 (init . (lambda ()
6381 (require 'bookmark-extensions)
6382 (bookmark-maybe-load-default-file)))
6383 (candidates . anything-c-bmkext-addressbook-setup-alist)
6384 (persistent-action
6385 . (lambda (candidate)
6386 (let ((bmk (anything-bookmark-get-bookmark-from-name
6387 candidate)))
6388 (bookmark--jump-via bmk 'pop-to-buffer))))
6389 (persistent-help . "Show contact - Prefix with C-u to append")
6390 (filtered-candidate-transformer
6391 anything-c-adaptive-sort
6392 anything-c-highlight-bookmark)
6393 (action . (("Show Contact(s)"
6394 . (lambda (candidate)
6395 (let* ((contacts (anything-marked-candidates))
6396 (current-prefix-arg (or anything-current-prefix-arg
6397 (> (length contacts) 1))))
6398 (bookmark-jump
6399 (anything-bookmark-get-bookmark-from-name (car contacts)))
6400 (anything-aif (cdr contacts)
6401 (loop for bmk in it do
6402 (bookmark-jump
6403 (anything-bookmark-get-bookmark-from-name bmk)))))))
6404 ("Send Mail"
6405 . (lambda (candidate)
6406 (let* ((contacts (anything-marked-candidates))
6407 (bmk (anything-bookmark-get-bookmark-from-name
6408 (car contacts)))
6409 (append (message-buffers)))
6410 (if append
6411 (addressbook-set-mail-buffer1 bmk 'append)
6412 (addressbook-set-mail-buffer1 bmk))
6413 (setq contacts (cdr contacts))
6414 (when contacts
6415 (loop for bmk in contacts do
6416 (addressbook-set-mail-buffer1 bmk 'append))))))
6417 ("Edit Bookmark"
6418 . (lambda (candidate)
6419 (let ((bmk (anything-bookmark-get-bookmark-from-name
6420 candidate)))
6421 (addressbook-bookmark-edit
6422 (assoc bmk bookmark-alist)))))
6423 ("Insert Email at point"
6424 . (lambda (candidate)
6425 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6426 candidate))
6427 (mlist (split-string
6428 (assoc-default
6429 'email (assoc bmk bookmark-alist))
6430 ", ")))
6431 (insert
6432 (if (> (length mlist) 1)
6433 (anything-comp-read
6434 "Insert Mail Address: " mlist :must-match t)
6435 (car mlist))))))
6436 ("Show annotation"
6437 . (lambda (candidate)
6438 (let ((bmk (anything-bookmark-get-bookmark-from-name
6439 candidate)))
6440 (bookmark-show-annotation bmk))))
6441 ("Edit annotation"
6442 . (lambda (candidate)
6443 (let ((bmk (anything-bookmark-get-bookmark-from-name
6444 candidate)))
6445 (bookmark-edit-annotation bmk))))
6446 ("Show Google map"
6447 . (lambda (candidate)
6448 (let* ((bmk (anything-bookmark-get-bookmark-from-name
6449 candidate))
6450 (full-bmk (assoc bmk bookmark-alist)))
6451 (addressbook-google-map full-bmk))))))))
6454 (defun anything-c-bmkext-addressbook-setup-alist ()
6455 "Specialized filter function for bookmarks w3m."
6456 (anything-c-bmkext-filter-setup-alist 'bmkext-addressbook-alist-only))
6458 ;; W3m bookmarks from bookmark-extensions.
6459 (defvar anything-c-source-bookmark-w3m
6460 '((name . "Bookmark W3m")
6461 (init . (lambda ()
6462 (require 'bookmark-extensions)
6463 (bookmark-maybe-load-default-file)))
6464 (candidates . anything-c-bookmark-w3m-setup-alist)
6465 (filtered-candidate-transformer
6466 anything-c-adaptive-sort
6467 anything-c-highlight-bookmark)
6468 (type . bookmark)))
6469 ;; (anything 'anything-c-source-bookmark-w3m)
6471 (defun anything-c-bookmark-w3m-setup-alist ()
6472 "Specialized filter function for bookmarks w3m."
6473 (anything-c-bmkext-filter-setup-alist 'bmkext-w3m-alist-only))
6475 ;; Images
6476 (defvar anything-c-source-bookmark-images
6477 '((name . "Bookmark Images")
6478 (init . (lambda ()
6479 (require 'bookmark-extensions)
6480 (bookmark-maybe-load-default-file)))
6481 (candidates . anything-c-bookmark-images-setup-alist)
6482 (filtered-candidate-transformer
6483 anything-c-adaptive-sort
6484 anything-c-highlight-bookmark)
6485 (type . bookmark)))
6486 ;; (anything 'anything-c-source-bookmark-images)
6488 (defun anything-c-bookmark-images-setup-alist ()
6489 "Specialized filter function for images bookmarks."
6490 (anything-c-bmkext-filter-setup-alist 'bmkext-image-file-alist-only))
6492 ;; Woman Man
6493 (defvar anything-c-source-bookmark-man
6494 '((name . "Bookmark Woman&Man")
6495 (init . (lambda ()
6496 (require 'bookmark-extensions)
6497 (bookmark-maybe-load-default-file)))
6498 (candidates . anything-c-bookmark-man-setup-alist)
6499 (filtered-candidate-transformer
6500 anything-c-adaptive-sort
6501 anything-c-highlight-bookmark)
6502 (type . bookmark)))
6503 ;; (anything 'anything-c-source-bookmark-man)
6505 (defun anything-c-bookmark-man-setup-alist ()
6506 "Specialized filter function for bookmarks w3m."
6507 (append (anything-c-bmkext-filter-setup-alist 'bmkext-man-alist-only)
6508 (anything-c-bmkext-filter-setup-alist 'bmkext-woman-alist-only)))
6510 ;; Gnus
6511 (defvar anything-c-source-bookmark-gnus
6512 '((name . "Bookmark Gnus")
6513 (init . (lambda ()
6514 (require 'bookmark-extensions)
6515 (bookmark-maybe-load-default-file)))
6516 (candidates . anything-c-bookmark-gnus-setup-alist)
6517 (filtered-candidate-transformer
6518 anything-c-adaptive-sort
6519 anything-c-highlight-bookmark)
6520 (type . bookmark)))
6521 ;; (anything 'anything-c-source-bookmark-gnus)
6523 (defun anything-c-bookmark-gnus-setup-alist ()
6524 "Specialized filter function for bookmarks gnus."
6525 (anything-c-bmkext-filter-setup-alist 'bmkext-gnus-alist-only))
6527 ;; Info
6528 (defvar anything-c-source-bookmark-info
6529 '((name . "Bookmark Info")
6530 (init . (lambda ()
6531 (require 'bookmark-extensions)
6532 (bookmark-maybe-load-default-file)))
6533 (candidates . anything-c-bookmark-info-setup-alist)
6534 (filtered-candidate-transformer
6535 anything-c-adaptive-sort
6536 anything-c-highlight-bookmark)
6537 (type . bookmark)))
6538 ;; (anything 'anything-c-source-bookmark-info)
6540 (defun anything-c-bookmark-info-setup-alist ()
6541 "Specialized filter function for bookmarks info."
6542 (anything-c-bmkext-filter-setup-alist 'bmkext-info-alist-only))
6544 ;; Local Files&directories
6545 (defvar anything-c-source-bookmark-files&dirs
6546 '((name . "Bookmark Files&Directories")
6547 (init . (lambda ()
6548 (require 'bookmark-extensions)
6549 (bookmark-maybe-load-default-file)))
6550 (candidates . anything-c-bookmark-local-files-setup-alist)
6551 (filtered-candidate-transformer
6552 anything-c-adaptive-sort
6553 anything-c-highlight-bookmark)
6554 (type . bookmark)))
6555 ;; (anything 'anything-c-source-bookmark-files&dirs)
6557 (defun anything-c-bookmark-local-files-setup-alist ()
6558 "Specialized filter function for bookmarks locals files."
6559 (anything-c-bmkext-filter-setup-alist 'bmkext-local-file-alist-only))
6561 ;; Su Files&directories
6562 (defvar anything-c-source-bookmark-su-files&dirs
6563 '((name . "Bookmark Root-Files&Directories")
6564 (init . (lambda ()
6565 (require 'bookmark-extensions)
6566 (bookmark-maybe-load-default-file)))
6567 (candidates . anything-c-bookmark-su-files-setup-alist)
6568 (filtered-candidate-transformer
6569 anything-c-adaptive-sort
6570 anything-c-highlight-bookmark-su)
6571 (type . bookmark)))
6572 ;; (anything 'anything-c-source-bookmark-su-files&dirs)
6574 (defun anything-c-bookmark-su-files-setup-alist ()
6575 "Specialized filter function for bookmarks su/sudo files."
6576 (declare (special bmkext-su-or-sudo-regexp))
6577 (loop
6578 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6579 for i in l
6580 for isfile = (bookmark-get-filename i)
6581 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6582 (save-match-data
6583 (string-match tramp-file-name-regexp isfile)))
6584 for issu = (and istramp
6585 (string-match bmkext-su-or-sudo-regexp isfile))
6586 if issu
6587 collect i))
6589 ;; Ssh Files&directories
6590 (defvar anything-c-source-bookmark-ssh-files&dirs
6591 '((name . "Bookmark Ssh-Files&Directories")
6592 (init . (lambda ()
6593 (require 'bookmark-extensions)
6594 (bookmark-maybe-load-default-file)))
6595 (candidates . anything-c-bookmark-ssh-files-setup-alist)
6596 (filtered-candidate-transformer . anything-c-adaptive-sort)
6597 (type . bookmark)))
6598 ;; (anything 'anything-c-source-bookmark-ssh-files&dirs)
6600 (defun anything-c-bookmark-ssh-files-setup-alist ()
6601 "Specialized filter function for bookmarks ssh files."
6602 (loop
6603 with l = (anything-c-bmkext-filter-setup-alist 'bmkext-remote-file-alist-only)
6604 for i in l
6605 for isfile = (bookmark-get-filename i)
6606 for istramp = (and isfile (boundp 'tramp-file-name-regexp)
6607 (save-match-data
6608 (string-match tramp-file-name-regexp isfile)))
6609 for isssh = (and istramp
6610 (string-match "/ssh:" isfile))
6611 if isssh
6612 collect i))
6615 ;; All bookmark-extensions sources.
6616 ;;;###autoload
6617 (defun anything-bookmark-ext ()
6618 "Preconfigured `anything' for bookmark-extensions sources.
6619 Needs bookmark-ext.el:
6620 <http://mercurial.intuxication.org/hg/emacs-bookmark-extension>.
6621 Contain also `anything-c-source-google-suggest'."
6622 (interactive)
6623 (anything
6624 :sources
6625 '(anything-c-source-bookmark-files&dirs
6626 anything-c-source-bookmark-w3m
6627 anything-c-source-google-suggest
6628 anything-c-source-bmkext-addressbook
6629 anything-c-source-bookmark-gnus
6630 anything-c-source-bookmark-info
6631 anything-c-source-bookmark-man
6632 anything-c-source-bookmark-images
6633 anything-c-source-bookmark-su-files&dirs
6634 anything-c-source-bookmark-ssh-files&dirs)
6635 :prompt "SearchBookmark: "
6636 :buffer "*anything bmkext*"))
6639 ;;; Firefox bookmarks
6642 ;; You will have to set firefox to import bookmarks in his html file bookmarks.html.
6643 ;; (only for firefox versions >=3)
6644 ;; To achieve that, open about:config in firefox and double click on this line to enable value
6645 ;; to true:
6646 ;; user_pref("browser.bookmarks.autoExportHTML", false);
6647 ;; You should have now:
6648 ;; user_pref("browser.bookmarks.autoExportHTML", true);
6650 (defvar anything-firefox-bookmark-url-regexp "\\(https\\|http\\|ftp\\|about\\|file\\)://[^ \"]*")
6651 (defvar anything-firefox-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6653 (defun anything-get-firefox-user-init-dir ()
6654 "Guess the default Firefox user directory name."
6655 (let* ((moz-dir (concat (getenv "HOME") "/.mozilla/firefox/"))
6656 (moz-user-dir
6657 (with-current-buffer (find-file-noselect (concat moz-dir "profiles.ini"))
6658 (goto-char (point-min))
6659 (prog1
6660 (when (search-forward "Path=" nil t)
6661 (buffer-substring-no-properties (point) (point-at-eol)))
6662 (kill-buffer)))))
6663 (file-name-as-directory (concat moz-dir moz-user-dir))))
6665 (defun anything-guess-firefox-bookmark-file ()
6666 "Return the path of the Firefox bookmarks file."
6667 (concat (anything-get-firefox-user-init-dir) "bookmarks.html"))
6669 (defun anything-html-bookmarks-to-alist (file url-regexp bmk-regexp)
6670 "Parse html bookmark FILE and return an alist with (title . url) as elements."
6671 (let (bookmarks-alist url title)
6672 (with-temp-buffer
6673 (insert-file-contents file)
6674 (goto-char (point-min))
6675 (while (re-search-forward "href=\\|^ *<DT><A HREF=" nil t)
6676 (forward-line 0)
6677 (when (re-search-forward url-regexp nil t)
6678 (setq url (match-string 0)))
6679 (when (re-search-forward bmk-regexp nil t)
6680 (setq title (match-string 1)))
6681 (push (cons title url) bookmarks-alist)
6682 (forward-line)))
6683 (nreverse bookmarks-alist)))
6685 (defvar anything-c-firefox-bookmarks-alist nil)
6686 (defvar anything-c-source-firefox-bookmarks
6687 '((name . "Firefox Bookmarks")
6688 (init . (lambda ()
6689 (setq anything-c-firefox-bookmarks-alist
6690 (anything-html-bookmarks-to-alist
6691 (anything-guess-firefox-bookmark-file)
6692 anything-firefox-bookmark-url-regexp
6693 anything-firefox-bookmarks-regexp))))
6694 (candidates . (lambda ()
6695 (mapcar #'car anything-c-firefox-bookmarks-alist)))
6696 (filtered-candidate-transformer
6697 anything-c-adaptive-sort
6698 anything-c-highlight-firefox-bookmarks)
6699 (action . (("Browse Url Firefox"
6700 . (lambda (candidate)
6701 (browse-url-firefox
6702 (anything-c-firefox-bookmarks-get-value candidate))))
6703 ("Browse Url w3m"
6704 . (lambda (candidate)
6705 (w3m-browse-url
6706 (anything-c-firefox-bookmarks-get-value candidate))))
6707 ("Copy Url"
6708 . (lambda (elm)
6709 (kill-new (anything-c-w3m-bookmarks-get-value elm))))))))
6711 ;; (anything 'anything-c-source-firefox-bookmarks)
6713 (defun anything-c-firefox-bookmarks-get-value (elm)
6714 (assoc-default elm anything-c-firefox-bookmarks-alist))
6716 (defun anything-c-highlight-firefox-bookmarks (bookmarks source)
6717 (loop for i in bookmarks
6718 collect (propertize
6719 i 'face '((:foreground "YellowGreen"))
6720 'help-echo (anything-c-firefox-bookmarks-get-value i))))
6722 ;;; W3m bookmark - anything interface.
6725 ;; Some users have the emacs-w3m library in load-path
6726 ;; without having the w3m executable :-;
6727 ;; So check if w3m program is present before trying to load
6728 ;; emacs-w3m.
6729 (eval-when-compile
6730 (when (executable-find "w3m")
6731 (require 'w3m-bookmark nil t)))
6733 (defvar w3m-bookmark-file "~/.w3m/bookmark.html")
6734 (defvar anything-w3m-bookmarks-regexp ">\\([^><]+.[^</a>]\\)")
6735 (defvar anything-w3m-bookmark-url-regexp "\\(https\\|http\\|ftp\\|file\\)://[^>]*")
6736 (defvar anything-c-w3m-bookmarks-alist nil)
6737 (defvar anything-c-source-w3m-bookmarks
6738 '((name . "W3m Bookmarks")
6739 (init . (lambda ()
6740 (setq anything-c-w3m-bookmarks-alist
6741 (anything-html-bookmarks-to-alist
6742 w3m-bookmark-file
6743 anything-w3m-bookmark-url-regexp
6744 anything-w3m-bookmarks-regexp))))
6745 (candidates . (lambda ()
6746 (mapcar #'car anything-c-w3m-bookmarks-alist)))
6747 (filtered-candidate-transformer
6748 anything-c-adaptive-sort
6749 anything-c-highlight-w3m-bookmarks)
6750 (action . (("Browse Url"
6751 . (lambda (candidate)
6752 (anything-c-w3m-browse-bookmark candidate)))
6753 ("Copy Url"
6754 . (lambda (elm)
6755 (kill-new (anything-c-w3m-bookmarks-get-value elm))))
6756 ("Browse Url Firefox"
6757 . (lambda (candidate)
6758 (anything-c-w3m-browse-bookmark candidate t)))
6759 ("Delete Bookmark"
6760 . (lambda (candidate)
6761 (anything-c-w3m-delete-bookmark candidate)))
6762 ("Rename Bookmark"
6763 . (lambda (candidate)
6764 (anything-c-w3m-rename-bookmark candidate)))))
6765 (persistent-action . (lambda (candidate)
6766 (if current-prefix-arg
6767 (anything-c-w3m-browse-bookmark candidate t)
6768 (anything-c-w3m-browse-bookmark candidate nil t))))
6769 (persistent-help . "Open URL with emacs-w3m in new tab / \
6770 C-u \\[anything-execute-persistent-action]: Open URL with Firefox"))
6771 "Needs w3m and emacs-w3m.
6773 http://w3m.sourceforge.net/
6774 http://emacs-w3m.namazu.org/")
6776 ;; (anything 'anything-c-source-w3m-bookmarks)
6778 (defun anything-c-w3m-bookmarks-get-value (elm)
6779 (replace-regexp-in-string
6780 "\"" "" (cdr (assoc elm anything-c-w3m-bookmarks-alist))))
6782 (defun anything-c-w3m-browse-bookmark (elm &optional use-firefox new-tab)
6783 (let* ((fn (if use-firefox 'browse-url-firefox 'w3m-browse-url))
6784 (arg (and (eq fn 'w3m-browse-url) new-tab)))
6785 (funcall fn (anything-c-w3m-bookmarks-get-value elm) arg)))
6787 (defun anything-c-highlight-w3m-bookmarks (bookmarks source)
6788 (loop for i in bookmarks
6789 collect (propertize
6790 i 'face 'anything-w3m-bookmarks-face
6791 'help-echo (anything-c-w3m-bookmarks-get-value i))))
6794 (defun anything-c-w3m-delete-bookmark (elm)
6795 "Delete w3m bookmark from `w3m-bookmark-file'."
6796 (with-current-buffer
6797 (find-file-literally w3m-bookmark-file)
6798 (goto-char (point-min))
6799 (when (re-search-forward elm nil t)
6800 (beginning-of-line)
6801 (delete-region (point)
6802 (line-end-position))
6803 (delete-blank-lines))
6804 (save-buffer)
6805 (kill-buffer)))
6807 (defun anything-c-w3m-rename-bookmark (elm)
6808 "Rename w3m bookmark in `w3m-bookmark-file'."
6809 (let* ((old-title (replace-regexp-in-string ">" "" elm))
6810 (new-title (read-string "NewTitle: " old-title)))
6811 (with-current-buffer
6812 (find-file-literally w3m-bookmark-file)
6813 (goto-char (point-min))
6814 (when (re-search-forward (concat elm "<") nil t)
6815 (goto-char (1- (point)))
6816 (delete-char (- (length old-title)))
6817 (insert new-title))
6818 (save-buffer)
6819 (kill-buffer))))
6821 ;;;; <Library>
6822 ;;; Elisp library scan
6823 (defvar anything-c-source-elisp-library-scan
6824 '((name . "Elisp libraries (Scan)")
6825 (init . (anything-c-elisp-library-scan-init))
6826 (candidates-in-buffer)
6827 (action ("Find library"
6828 . (lambda (candidate) (find-file (find-library-name candidate))))
6829 ("Find library other window"
6830 . (lambda (candidate)
6831 (find-file-other-window (find-library-name candidate))))
6832 ("Load library"
6833 . (lambda (candidate) (load-library candidate))))))
6834 ;; (anything 'anything-c-source-elisp-library-scan)
6836 (defun anything-c-elisp-library-scan-init ()
6837 "Init anything buffer status."
6838 (let ((anything-buffer (anything-candidate-buffer 'global))
6839 (library-list (anything-c-elisp-library-scan-list)))
6840 (with-current-buffer anything-buffer
6841 (dolist (library library-list)
6842 (insert (format "%s\n" library))))))
6844 (defun anything-c-elisp-library-scan-list (&optional dirs string)
6845 "Do completion for file names passed to `locate-file'.
6846 DIRS is directory to search path.
6847 STRING is string to match."
6848 ;; Use `load-path' as path when ignore `dirs'.
6849 (or dirs (setq dirs load-path))
6850 ;; Init with blank when ignore `string'.
6851 (or string (setq string ""))
6852 ;; Get library list.
6853 (let ((string-dir (file-name-directory string))
6854 ;; File regexp that suffix match `load-file-rep-suffixes'.
6855 (match-regexp (format "^.*\\.el%s$" (regexp-opt load-file-rep-suffixes)))
6856 name
6857 names)
6858 (dolist (dir dirs)
6859 (unless dir
6860 (setq dir default-directory))
6861 (if string-dir
6862 (setq dir (expand-file-name string-dir dir)))
6863 (when (file-directory-p dir)
6864 (dolist (file (file-name-all-completions
6865 (file-name-nondirectory string) dir))
6866 ;; Suffixes match `load-file-rep-suffixes'.
6867 (setq name (if string-dir (concat string-dir file) file))
6868 (if (string-match match-regexp name)
6869 (add-to-list 'names name)))))
6870 names))
6872 ;;;; <Programming>
6876 ;;; Imenu
6879 (defvar anything-c-imenu-delimiter " / ")
6881 (defvar anything-c-imenu-index-filter nil)
6882 (make-variable-buffer-local 'anything-c-imenu-index-filter)
6884 (defvar anything-c-cached-imenu-alist nil)
6885 (make-variable-buffer-local 'anything-c-cached-imenu-alist)
6887 (defvar anything-c-cached-imenu-candidates nil)
6888 (make-variable-buffer-local 'anything-c-cached-imenu-candidates)
6890 (defvar anything-c-cached-imenu-tick nil)
6891 (make-variable-buffer-local 'anything-c-cached-imenu-tick)
6893 (eval-when-compile (require 'imenu))
6894 (setq imenu-auto-rescan t)
6896 (defun anything-imenu-create-candidates (entry)
6897 "Create candidates with ENTRY."
6898 (if (listp (cdr entry))
6899 (mapcan
6900 (lambda (sub)
6901 (if (consp (cdr sub))
6902 (mapcar
6903 (lambda (subentry)
6904 (concat (car entry) anything-c-imenu-delimiter subentry))
6905 (anything-imenu-create-candidates sub))
6906 (list (concat (car entry) anything-c-imenu-delimiter (car sub)))))
6907 (cdr entry))
6908 (list entry)))
6910 (defvar anything-c-source-imenu
6911 '((name . "Imenu")
6912 (init . (lambda () (require 'imenu)))
6913 (candidates . anything-c-imenu-candidates)
6914 (persistent-action . (lambda (elm)
6915 (anything-c-imenu-default-action elm)
6916 (unless (fboundp 'semantic-imenu-tag-overlay)
6917 (anything-match-line-color-current-line))))
6918 (persistent-help . "Show this entry")
6919 (action . anything-c-imenu-default-action))
6920 "See (info \"(emacs)Imenu\")")
6922 ;; (anything 'anything-c-source-imenu)
6924 (defun anything-c-imenu-candidates ()
6925 (with-current-buffer anything-current-buffer
6926 (let ((tick (buffer-modified-tick)))
6927 (if (eq anything-c-cached-imenu-tick tick)
6928 anything-c-cached-imenu-candidates
6929 (setq imenu--index-alist nil)
6930 (setq anything-c-cached-imenu-tick tick
6931 anything-c-cached-imenu-candidates
6932 (ignore-errors
6933 (mapcan
6934 'anything-imenu-create-candidates
6935 (setq anything-c-cached-imenu-alist
6936 (let ((index (imenu--make-index-alist)))
6937 (if anything-c-imenu-index-filter
6938 (funcall anything-c-imenu-index-filter index)
6939 index))))))
6940 (setq anything-c-cached-imenu-candidates
6941 (mapcar #'(lambda (x)
6942 (if (stringp x)
6944 (car x)))
6945 anything-c-cached-imenu-candidates))))))
6947 (setq imenu-default-goto-function 'imenu-default-goto-function)
6948 (defun anything-c-imenu-default-action (elm)
6949 "The default action for `anything-c-source-imenu'."
6950 (let ((path (split-string elm anything-c-imenu-delimiter))
6951 (alist anything-c-cached-imenu-alist))
6952 (dolist (elm path)
6953 (setq alist (assoc elm alist)))
6954 (imenu alist)))
6956 ;;; Ctags
6959 (defvar anything-c-ctags-modes
6960 '( c-mode c++-mode awk-mode csharp-mode java-mode javascript-mode lua-mode
6961 makefile-mode pascal-mode perl-mode cperl-mode php-mode python-mode
6962 scheme-mode sh-mode slang-mode sql-mode tcl-mode ))
6964 (defun anything-c-source-ctags-init ()
6965 (when (and buffer-file-name
6966 (memq major-mode anything-c-ctags-modes)
6967 (anything-current-buffer-is-modified))
6968 (with-current-buffer (anything-candidate-buffer 'local)
6969 (call-process-shell-command
6970 (if (string-match "\\.el\\.gz$" anything-buffer-file-name)
6971 (format "ctags -e -u -f- --language-force=lisp --fields=n =(zcat %s) "
6972 anything-buffer-file-name)
6973 (format "ctags -e -u -f- --fields=n %s " anything-buffer-file-name))
6974 nil (current-buffer))
6975 (goto-char (point-min))
6976 (forward-line 2)
6977 (delete-region (point-min) (point))
6978 (loop while (and (not (eobp)) (search-forward "\001" (point-at-eol) t))
6979 for lineno-start = (point)
6980 for lineno = (buffer-substring
6981 lineno-start
6982 (1- (search-forward "," (point-at-eol) t)))
6984 (beginning-of-line)
6985 (insert (format "%5s:" lineno))
6986 (search-forward "\177" (point-at-eol) t)
6987 (delete-region (1- (point)) (point-at-eol))
6988 (forward-line 1)))))
6990 (defvar anything-c-source-ctags
6991 '((name . "Exuberant ctags")
6992 (init . anything-c-source-ctags-init)
6993 (candidates-in-buffer)
6994 (adjust)
6995 (type . line))
6996 "Needs Exuberant Ctags.
6998 http://ctags.sourceforge.net/")
6999 ;; (anything 'anything-c-source-ctags)
7001 ;;; Semantic
7004 (defvar anything-semantic-candidates nil)
7006 (defun anything-semantic-construct-candidates (tags depth)
7007 (when (require 'semantic nil t)
7008 (apply
7009 'append
7010 (mapcar
7011 (lambda (tag)
7012 (if (listp tag)
7013 (let ((type (semantic-tag-type tag))
7014 (class (semantic-tag-class tag)))
7015 (if (or (and (stringp type)
7016 (or (string= type "class")
7017 (string= type "namespace")))
7018 (eq class 'function)
7019 (eq class 'variable))
7020 (cons (cons (concat (make-string (* depth 2) ?\s)
7021 (semantic-format-tag-summarize tag nil t))
7022 tag)
7023 (anything-semantic-construct-candidates
7024 (semantic-tag-components tag) (1+ depth)))))))
7025 tags))))
7027 (defun anything-semantic-default-action (candidate)
7028 (let ((tag (cdr (assoc candidate anything-semantic-candidates))))
7029 (semantic-go-to-tag tag)))
7031 (defvar anything-c-source-semantic
7032 '((name . "Semantic Tags")
7033 (init . (lambda ()
7034 (setq anything-semantic-candidates
7035 (ignore-errors (anything-semantic-construct-candidates
7036 (semantic-fetch-tags) 0)))))
7037 (candidates . (lambda ()
7038 (if anything-semantic-candidates
7039 (mapcar 'car anything-semantic-candidates))))
7040 (persistent-action . (lambda (elm)
7041 (anything-semantic-default-action elm)
7042 (anything-match-line-color-current-line)))
7043 (persistent-help . "Show this entry")
7044 (action . anything-semantic-default-action)
7045 "Needs semantic in CEDET.
7047 http://cedet.sourceforge.net/semantic.shtml
7048 http://cedet.sourceforge.net/"))
7050 ;; (anything 'anything-c-source-semantic)
7052 ;;; Function is called by
7053 ;;;###autoload
7054 (defun anything-simple-call-tree ()
7055 "Preconfigured `anything' for simple-call-tree. List function relationships.
7057 Needs simple-call-tree.el.
7058 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el"
7059 (interactive)
7060 (anything-other-buffer
7061 '(anything-c-source-simple-call-tree-functions-callers
7062 anything-c-source-simple-call-tree-callers-functions)
7063 "*anything simple-call-tree*"))
7065 (defvar anything-c-source-simple-call-tree-functions-callers
7066 '((name . "Function is called by")
7067 (init . anything-c-simple-call-tree-functions-callers-init)
7068 (multiline)
7069 (candidates . anything-c-simple-call-tree-candidates)
7070 (persistent-action . anything-c-simple-call-tree-persistent-action)
7071 (persistent-help . "Show function definitions by rotation")
7072 (action ("Find definition selected by persistent-action" .
7073 anything-c-simple-call-tree-find-definition)))
7074 "Needs simple-call-tree.el.
7075 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7077 (defvar anything-c-simple-call-tree-tick nil)
7078 (make-variable-buffer-local 'anything-c-simple-call-tree-tick)
7079 (defun anything-c-simple-call-tree-analyze-maybe ()
7080 (unless (eq (buffer-chars-modified-tick) anything-c-simple-call-tree-tick)
7081 (simple-call-tree-analyze)
7082 (setq anything-c-simple-call-tree-tick (buffer-chars-modified-tick))))
7084 (defun anything-c-simple-call-tree-init-base (function message)
7085 (require 'simple-call-tree)
7086 (with-no-warnings
7087 (when (anything-current-buffer-is-modified)
7088 (anything-c-simple-call-tree-analyze-maybe)
7089 (let ((list (funcall function simple-call-tree-alist)))
7090 (with-current-buffer (anything-candidate-buffer 'local)
7091 (dolist (entry list)
7092 (let ((funcs (concat " " (mapconcat #'identity (cdr entry) "\n "))))
7093 (insert (car entry) message
7094 (if (string= funcs " ")
7095 " no functions."
7096 funcs)
7097 "\n\n"))))))))
7099 (defun anything-c-simple-call-tree-functions-callers-init ()
7100 (anything-c-simple-call-tree-init-base 'simple-call-tree-invert
7101 " is called by\n"))
7103 (defun anything-c-simple-call-tree-candidates ()
7104 (with-current-buffer (anything-candidate-buffer)
7105 (split-string (buffer-string) "\n\n")))
7107 (defvar anything-c-simple-call-tree-related-functions nil)
7108 (defvar anything-c-simple-call-tree-function-index 0)
7109 (defun anything-c-simple-call-tree-persistent-action (candidate)
7110 (unless (eq last-command 'anything-execute-persistent-action)
7111 (setq anything-c-simple-call-tree-related-functions
7112 (delete "no functions."
7113 (split-string
7114 (replace-regexp-in-string " \\| is called by\\| calls "
7115 "" candidate)
7116 "\n")))
7117 (setq anything-c-simple-call-tree-function-index -1))
7118 (incf anything-c-simple-call-tree-function-index)
7119 (anything-c-simple-call-tree-find-definition candidate))
7121 (defun anything-c-simple-call-tree-find-definition (candidate)
7122 (find-function
7123 (intern
7124 (nth (mod anything-c-simple-call-tree-function-index
7125 (length anything-c-simple-call-tree-related-functions))
7126 anything-c-simple-call-tree-related-functions))))
7128 ;; (anything 'anything-c-source-simple-call-tree-functions-callers)
7130 ;;; Function calls
7131 (defvar anything-c-source-simple-call-tree-callers-functions
7132 '((name . "Function calls")
7133 (init . anything-c-simple-call-tree-callers-functions-init)
7134 (multiline)
7135 (candidates . anything-c-simple-call-tree-candidates)
7136 (persistent-action . anything-c-simple-call-tree-persistent-action)
7137 (persistent-help . "Show function definitions by rotation")
7138 (action ("Find definition selected by persistent-action" .
7139 anything-c-simple-call-tree-find-definition)))
7140 "Needs simple-call-tree.el.
7141 http://www.emacswiki.org/cgi-bin/wiki/download/simple-call-tree.el")
7143 (defun anything-c-simple-call-tree-callers-functions-init ()
7144 (anything-c-simple-call-tree-init-base 'identity " calls \n"))
7146 ;; (anything 'anything-c-source-simple-call-tree-callers-functions)
7148 ;;; Commands/Options with doc
7149 (defvar anything-c-auto-document-data nil)
7150 (make-variable-buffer-local 'anything-c-auto-document-data)
7151 (defvar anything-c-source-commands-and-options-in-file
7152 '((name . "Commands/Options in file")
7153 (header-name
7154 . (lambda (x) (format "Commands/Options in %s"
7155 (buffer-local-value 'buffer-file-name
7156 anything-current-buffer))))
7157 (candidates . anything-command-and-options-candidates)
7158 (multiline)
7159 (action . imenu))
7160 "List Commands and Options with doc. It needs auto-document.el .
7162 http://www.emacswiki.org/cgi-bin/wiki/download/auto-document.el")
7164 (eval-when-compile (require 'auto-document nil t))
7165 (defun anything-command-and-options-candidates ()
7166 (with-current-buffer anything-current-buffer
7167 (when (and (require 'auto-document nil t)
7168 (eq major-mode 'emacs-lisp-mode)
7169 (or (anything-current-buffer-is-modified)
7170 (not anything-c-auto-document-data)))
7171 (or imenu--index-alist (imenu--make-index-alist t))
7172 (setq anything-c-auto-document-data
7173 (destructuring-bind (commands options)
7174 (adoc-construct anything-current-buffer)
7175 (append
7176 (loop for (command . doc) in commands
7177 for cmdname = (symbol-name command)
7178 collect
7179 (cons
7180 (format "Command: %s\n %s"
7181 (propertize cmdname 'face font-lock-function-name-face)
7182 (adoc-first-line doc))
7183 (assoc cmdname imenu--index-alist)))
7184 (loop with var-alist = (cdr (assoc "Variables" imenu--index-alist))
7185 for (option doc default) in options
7186 for optname = (symbol-name option)
7187 collect
7188 (cons
7189 (format "Option: %s\n %s\n default = %s"
7190 (propertize optname 'face font-lock-variable-name-face)
7191 (adoc-first-line doc)
7192 (adoc-prin1-to-string default))
7193 (assoc optname
7194 var-alist)))))))
7195 anything-c-auto-document-data))
7197 ;; (anything 'anything-c-source-commands-and-options-in-file)
7199 ;;;; <Color and Face>
7200 ;;; Customize Face
7201 (defvar anything-c-source-customize-face
7202 '((name . "Customize Face")
7203 (init . (lambda ()
7204 (unless (anything-candidate-buffer)
7205 (save-window-excursion (list-faces-display))
7206 (anything-candidate-buffer (get-buffer "*Faces*")))))
7207 (candidates-in-buffer)
7208 (get-line . buffer-substring)
7209 (action . (lambda (line)
7210 (customize-face (intern (car (split-string line))))))
7211 (requires-pattern . 3))
7212 "See (info \"(emacs)Faces\")")
7213 ;; (anything 'anything-c-source-customize-face)
7215 ;; Color
7216 (defvar anything-c-source-colors
7217 '((name . "Colors")
7218 (init . (lambda () (unless (anything-candidate-buffer)
7219 (save-window-excursion (list-colors-display))
7220 (anything-candidate-buffer (get-buffer "*Colors*")))))
7221 (candidates-in-buffer)
7222 (get-line . buffer-substring)
7223 (action
7224 ("Copy Name" . (lambda (candidate)
7225 (kill-new (anything-c-colors-get-name candidate))))
7226 ("Copy RGB" . (lambda (candidate)
7227 (kill-new (anything-c-colors-get-rgb candidate))))
7228 ("Insert Name" . (lambda (candidate)
7229 (with-current-buffer anything-current-buffer
7230 (insert (anything-c-colors-get-name candidate)))))
7231 ("Insert RGB" . (lambda (candidate)
7232 (with-current-buffer anything-current-buffer
7233 (insert (anything-c-colors-get-rgb candidate))))))))
7234 ;; (anything 'anything-c-source-colors)
7236 (defun anything-c-colors-get-name (candidate)
7237 "Get color name."
7238 (replace-regexp-in-string
7239 " " ""
7240 (with-temp-buffer
7241 (insert (capitalize candidate))
7242 (goto-char (point-min))
7243 (search-forward-regexp "\\s-\\{2,\\}")
7244 (delete-region (point) (point-max))
7245 (buffer-string))))
7247 (defun anything-c-colors-get-rgb (candidate)
7248 "Get color RGB."
7249 (replace-regexp-in-string
7250 " " ""
7251 (with-temp-buffer
7252 (insert (capitalize candidate))
7253 (goto-char (point-max))
7254 (search-backward-regexp "\\s-\\{2,\\}")
7255 (delete-region (point) (point-min))
7256 (buffer-string))))
7258 ;;;; <Search Engine>
7259 ;;; Tracker desktop search
7260 (defvar anything-c-source-tracker-search
7261 '((name . "Tracker Search")
7262 (candidates . (lambda ()
7263 (start-process "tracker-search-process" nil
7264 "tracker-search"
7265 anything-pattern)))
7266 (type . file)
7267 (requires-pattern . 3)
7268 (delayed))
7269 "Source for retrieving files matching the current input pattern
7270 with the tracker desktop search.")
7271 ;; (anything 'anything-c-source-tracker-search)
7273 ;;; Spotlight (MacOS X desktop search)
7274 (defvar anything-c-source-mac-spotlight
7275 '((name . "mdfind")
7276 (candidates
7277 . (lambda () (start-process "mdfind-process" nil "mdfind" anything-pattern)))
7278 (type . file)
7279 (requires-pattern . 3)
7280 (delayed))
7281 "Source for retrieving files via Spotlight's command line
7282 utility mdfind.")
7283 ;; (anything 'anything-c-source-mac-spotlight)
7286 ;;;; <Kill ring>
7287 ;;; Kill ring
7288 (defvar anything-c-source-kill-ring
7289 '((name . "Kill Ring")
7290 (init . (lambda () (anything-attrset 'last-command last-command)))
7291 (candidates . anything-c-kill-ring-candidates)
7292 (action . anything-c-kill-ring-action)
7293 (last-command)
7294 (migemo)
7295 (multiline))
7296 "Source for browse and insert contents of kill-ring.")
7298 (defun anything-c-kill-ring-candidates ()
7299 (loop for kill in kill-ring
7300 unless (or (< (length kill) anything-kill-ring-threshold)
7301 (string-match "^[\\s\\t]+$" kill))
7302 collect kill))
7304 (defun anything-c-kill-ring-action (str)
7305 "Insert STR in `kill-ring' and set STR to the head.
7306 If this action is executed just after `yank',
7307 replace with STR as yanked string."
7308 (setq kill-ring (delete str kill-ring))
7309 (if (not (eq (anything-attr 'last-command) 'yank))
7310 (insert-for-yank str)
7311 ;; from `yank-pop'
7312 (let ((inhibit-read-only t)
7313 (before (< (point) (mark t))))
7314 (if before
7315 (funcall (or yank-undo-function 'delete-region) (point) (mark t))
7316 (funcall (or yank-undo-function 'delete-region) (mark t) (point)))
7317 (setq yank-undo-function nil)
7318 (set-marker (mark-marker) (point) (current-buffer))
7319 (insert-for-yank str)
7320 ;; Set the window start back where it was in the yank command,
7321 ;; if possible.
7322 (set-window-start (selected-window) yank-window-start t)
7323 (if before
7324 ;; This is like exchange-point-and-mark, but doesn't activate the mark.
7325 ;; It is cleaner to avoid activation, even though the command
7326 ;; loop would deactivate the mark because we inserted text.
7327 (goto-char (prog1 (mark t)
7328 (set-marker (mark-marker) (point) (current-buffer)))))))
7329 (kill-new str))
7331 ;; (anything 'anything-c-source-kill-ring)
7333 ;;;; <Mark ring>
7334 ;; DO NOT include these sources in `anything-sources' use
7335 ;; the commands `anything-mark-ring', `anything-global-mark-ring' or
7336 ;; `anything-all-mark-rings' instead.
7338 (defun anything-c-source-mark-ring-candidates ()
7339 (flet ((get-marks (pos)
7340 (save-excursion
7341 (goto-char pos)
7342 (beginning-of-line)
7343 (let ((line (car (split-string (thing-at-point 'line) "[\n\r]"))))
7344 (when (string= "" line)
7345 (setq line "<EMPTY LINE>"))
7346 (format "%7d: %s" (line-number-at-pos) line)))))
7347 (with-current-buffer anything-current-buffer
7348 (loop
7349 with marks = (if (mark) (cons (mark-marker) mark-ring) mark-ring)
7350 with recip = nil
7351 for i in marks
7352 for m = (get-marks i)
7353 unless (member m recip)
7354 collect m into recip
7355 finally return recip))))
7357 (defvar anything-mark-ring-cache nil)
7358 (defvar anything-c-source-mark-ring
7359 '((name . "mark-ring")
7360 (init . (lambda ()
7361 (setq anything-mark-ring-cache
7362 (ignore-errors (anything-c-source-mark-ring-candidates)))))
7363 (candidates . (lambda ()
7364 (anything-aif anything-mark-ring-cache
7365 it)))
7366 (action . (("Goto line"
7367 . (lambda (candidate)
7368 (anything-goto-line (string-to-number candidate))))))
7369 (persistent-action . (lambda (candidate)
7370 (anything-goto-line (string-to-number candidate))
7371 (anything-match-line-color-current-line)))
7372 (persistent-help . "Show this line")))
7374 ;; (anything 'anything-c-source-mark-ring)
7376 ;;;###autoload
7377 (defun anything-mark-ring ()
7378 "Preconfigured `anything' for `anything-c-source-mark-ring'."
7379 (interactive)
7380 (anything 'anything-c-source-mark-ring))
7382 ;;; Global-mark-ring
7383 (defvar anything-c-source-global-mark-ring
7384 '((name . "global-mark-ring")
7385 (candidates . anything-c-source-global-mark-ring-candidates)
7386 (action . (("Goto line"
7387 . (lambda (candidate)
7388 (let ((items (split-string candidate ":")))
7389 (anything-c-switch-to-buffer (second items))
7390 (anything-goto-line (string-to-number (car items))))))))
7391 (persistent-action . (lambda (candidate)
7392 (let ((items (split-string candidate ":")))
7393 (anything-c-switch-to-buffer (second items))
7394 (anything-goto-line (string-to-number (car items)))
7395 (anything-match-line-color-current-line))))
7396 (persistent-help . "Show this line")))
7398 (defun anything-c-source-global-mark-ring-candidates ()
7399 (flet ((buf-fn (m)
7400 (with-current-buffer (marker-buffer m)
7401 (goto-char m)
7402 (beginning-of-line)
7403 (let (line)
7404 (if (string= "" line)
7405 (setq line "<EMPTY LINE>")
7406 (setq line (car (split-string (thing-at-point 'line)
7407 "[\n\r]"))))
7408 (format "%7d:%s: %s"
7409 (line-number-at-pos) (marker-buffer m) line)))))
7410 (loop
7411 with marks = global-mark-ring
7412 with recip = nil
7413 for i in marks
7414 for gm = (unless (or (string-match
7415 "^ " (format "%s" (marker-buffer i)))
7416 (null (marker-buffer i)))
7417 (buf-fn i))
7418 when (and gm (not (member gm recip)))
7419 collect gm into recip
7420 finally return recip)))
7422 ;; (anything 'anything-c-source-global-mark-ring)
7424 ;;;###autoload
7425 (defun anything-global-mark-ring ()
7426 "Preconfigured `anything' for `anything-c-source-global-mark-ring'."
7427 (interactive)
7428 (anything 'anything-c-source-global-mark-ring))
7430 ;;;###autoload
7431 (defun anything-all-mark-rings ()
7432 "Preconfigured `anything' for `anything-c-source-global-mark-ring' and \
7433 `anything-c-source-mark-ring'."
7434 (interactive)
7435 (anything '(anything-c-source-mark-ring
7436 anything-c-source-global-mark-ring)))
7438 ;;;; <Register>
7439 ;;; Insert from register
7440 (defvar anything-c-source-register
7441 '((name . "Registers")
7442 (candidates . anything-c-register-candidates)
7443 (action-transformer . anything-c-register-action-transformer)
7444 (multiline)
7445 (action))
7446 "See (info \"(emacs)Registers\")")
7448 (defun anything-c-register-candidates ()
7449 "Collecting register contents and appropriate commands."
7450 (loop for (char . val) in register-alist
7451 for key = (single-key-description char)
7452 for string-actions =
7453 (cond
7454 ((numberp val)
7455 (list (int-to-string val)
7456 'insert-register
7457 'increment-register))
7458 ((markerp val)
7459 (let ((buf (marker-buffer val)))
7460 (if (null buf)
7461 (list "a marker in no buffer")
7462 (list (concat
7463 "a buffer position:"
7464 (buffer-name buf)
7465 ", position "
7466 (int-to-string (marker-position val)))
7467 'jump-to-register
7468 'insert-register))))
7469 ((and (consp val) (window-configuration-p (car val)))
7470 (list "window configuration."
7471 'jump-to-register))
7472 ((and (consp val) (frame-configuration-p (car val)))
7473 (list "frame configuration."
7474 'jump-to-register))
7475 ((and (consp val) (eq (car val) 'file))
7476 (list (concat "file:"
7477 (prin1-to-string (cdr val))
7478 ".")
7479 'jump-to-register))
7480 ((and (consp val) (eq (car val) 'file-query))
7481 (list (concat "file:a file-query reference: file "
7482 (car (cdr val))
7483 ", position "
7484 (int-to-string (car (cdr (cdr val))))
7485 ".")
7486 'jump-to-register))
7487 ((consp val)
7488 (let ((lines (format "%4d" (length val))))
7489 (list (format "%s: %s\n" lines
7490 (truncate-string-to-width
7491 (mapconcat 'identity (list (car val))
7492 ;; (mapconcat (lambda (y) y) val
7493 "^J") (- (window-width) 15)))
7494 'insert-register)))
7495 ((stringp val)
7496 (list ;; without properties
7497 (substring-no-properties val)
7498 'insert-register
7499 'append-to-register
7500 'prepend-to-register))
7502 "GARBAGE!"))
7503 collect (cons (format "register %3s: %s" key (car string-actions))
7504 (cons char (cdr string-actions)))))
7506 (defun anything-c-register-action-transformer (actions register-and-functions)
7507 "Decide actions by the contents of register."
7508 (loop with func-actions =
7509 '((insert-register
7510 "Insert Register" .
7511 (lambda (c) (insert-register (car c))))
7512 (jump-to-register
7513 "Jump to Register" .
7514 (lambda (c) (jump-to-register (car c))))
7515 (append-to-register
7516 "Append Region to Register" .
7517 (lambda (c) (append-to-register
7518 (car c) (region-beginning) (region-end))))
7519 (prepend-to-register
7520 "Prepend Region to Register" .
7521 (lambda (c) (prepend-to-register
7522 (car c) (region-beginning) (region-end))))
7523 (increment-register
7524 "Increment Prefix Arg to Register" .
7525 (lambda (c) (increment-register
7526 anything-current-prefix-arg (car c)))))
7527 for func in (cdr register-and-functions)
7528 for cell = (assq func func-actions)
7529 when cell
7530 collect (cdr cell)))
7532 ;; (anything 'anything-c-source-register)
7534 ;;; Latex completion
7535 (defun anything-c-latex-math-candidates ()
7536 "Collect candidates for latex math completion."
7537 (declare (special LaTeX-math-menu))
7538 (loop for i in (cddr LaTeX-math-menu)
7539 for elm = (loop for s in i when (vectorp s)
7540 collect (cons (aref s 0) (aref s 1)))
7541 append elm))
7543 (defvar anything-c-source-latex-math
7544 '((name . "Latex Math Menu")
7545 (init . (lambda ()
7546 (with-current-buffer anything-current-buffer
7547 (LaTeX-math-mode 1))))
7548 (candidate-number-limit . 9999)
7549 (candidates . anything-c-latex-math-candidates)
7550 (action . (lambda (candidate)
7551 (call-interactively candidate)))))
7553 ;;;; <Headline Extraction>
7554 (defvar anything-c-source-fixme
7555 '((name . "TODO/FIXME/DRY comments")
7556 (headline . "^.*\\<\\(TODO\\|FIXME\\|DRY\\)\\>.*$")
7557 (adjust)
7558 (recenter))
7559 "Show TODO/FIXME/DRY comments in current file.")
7560 ;; (anything 'anything-c-source-fixme)
7562 (defvar anything-c-source-rd-headline
7563 '((name . "RD HeadLine")
7564 (headline "^= \\(.+\\)$" "^== \\(.+\\)$" "^=== \\(.+\\)$" "^==== \\(.+\\)$")
7565 (condition . (memq major-mode '(rdgrep-mode rd-mode)))
7566 (migemo)
7567 (subexp . 1))
7568 "Show RD headlines.
7570 RD is Ruby's POD.
7571 http://en.wikipedia.org/wiki/Ruby_Document_format")
7572 ;; (anything 'anything-c-source-rd-headline)
7574 (defvar anything-c-source-oddmuse-headline
7575 '((name . "Oddmuse HeadLine")
7576 (headline "^= \\(.+\\) =$" "^== \\(.+\\) ==$"
7577 "^=== \\(.+\\) ===$" "^==== \\(.+\\) ====$")
7578 (condition . (memq major-mode '(oddmuse-mode yaoddmuse-mode)))
7579 (migemo)
7580 (subexp . 1))
7581 "Show Oddmuse headlines, such as EmacsWiki.")
7582 ;; (anything 'anything-c-source-oddmuse-headline)
7584 (defvar anything-c-source-emacs-source-defun
7585 '((name . "Emacs Source DEFUN")
7586 (headline . "DEFUN\\|DEFVAR")
7587 (condition . (string-match "/emacs2[0-9].+/src/.+c$"
7588 (or buffer-file-name ""))))
7589 "Show DEFUN/DEFVAR in Emacs C source file.")
7590 ;; (anything 'anything-c-source-emacs-source-defun)
7592 (defvar anything-c-source-emacs-lisp-expectations
7593 '((name . "Emacs Lisp Expectations")
7594 (headline . "(desc[ ]\\|(expectations")
7595 (condition . (eq major-mode 'emacs-lisp-mode)))
7596 "Show descriptions (desc) in Emacs Lisp Expectations.
7598 http://www.emacswiki.org/cgi-bin/wiki/download/el-expectations.el")
7599 ;; (anything 'anything-c-source-emacs-lisp-expectations)
7601 (defvar anything-c-source-emacs-lisp-toplevels
7602 '((name . "Emacs Lisp Toplevel / Level 4 Comment / Linkd Star")
7603 (headline . "^(\\|(@\\*\\|^;;;;")
7604 (get-line . buffer-substring)
7605 (condition . (eq major-mode 'emacs-lisp-mode))
7606 (adjust))
7607 "Show top-level forms, level 4 comments and linkd stars (optional) in Emacs Lisp.
7608 linkd.el is optional because linkd stars are extracted by regexp.
7609 http://www.emacswiki.org/cgi-bin/wiki/download/linkd.el")
7610 ;; (anything 'anything-c-source-emacs-lisp-toplevels)
7612 ;;; Anything yaoddmuse
7614 ;; Be sure to have yaoddmuse.el installed
7615 ;; install-elisp may be required if you want to install elisp file from here.
7616 (defvar anything-yaoddmuse-use-cache-file nil)
7617 (defvar anything-c-yaoddmuse-cache-file "~/.emacs.d/yaoddmuse-cache.el")
7618 (defvar anything-c-yaoddmuse-ew-cache nil)
7620 (defun anything-yaoddmuse-get-candidates ()
7621 (declare (special yaoddmuse-pages-hash))
7622 (if anything-yaoddmuse-use-cache-file
7623 (ignore-errors
7624 (unless anything-c-yaoddmuse-ew-cache
7625 (load anything-c-yaoddmuse-cache-file)
7626 (setq anything-c-yaoddmuse-ew-cache
7627 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7628 anything-c-yaoddmuse-ew-cache)
7629 (yaoddmuse-update-pagename t)
7630 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7632 (defvar anything-c-source-yaoddmuse-emacswiki-edit-or-view
7633 '((name . "Yaoddmuse Edit or View (EmacsWiki)")
7634 (candidates . anything-yaoddmuse-get-candidates)
7635 (action . (("Edit page" . (lambda (candidate)
7636 (yaoddmuse-edit "EmacsWiki" candidate)))
7637 ("Browse page" . (lambda (candidate)
7638 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7639 ("Browse page other window" . (lambda (candidate)
7640 (if (one-window-p)
7641 (split-window-vertically))
7642 (yaoddmuse-browse-page "EmacsWiki" candidate)))
7643 ("Browse diff" . (lambda (candidate)
7644 (yaoddmuse-browse-page-diff "EmacsWiki" candidate)))
7645 ("Copy URL" . (lambda (candidate)
7646 (kill-new (yaoddmuse-url "EmacsWiki" candidate))
7647 (message "Have copy page %s's URL to yank." candidate)))
7648 ("Create page" . (lambda (candidate)
7649 (yaoddmuse-edit "EmacsWiki" anything-input)))
7650 ("Update cache" . (lambda (candidate)
7651 (if anything-yaoddmuse-use-cache-file
7652 (progn
7653 (anything-yaoddmuse-cache-pages t)
7654 (setq anything-c-yaoddmuse-ew-cache
7655 (gethash "EmacsWiki" yaoddmuse-pages-hash)))
7656 (yaoddmuse-update-pagename))))))
7657 (action-transformer anything-c-yaoddmuse-action-transformer))
7658 "Needs yaoddmuse.el.
7660 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7662 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view)
7664 (defvar anything-c-source-yaoddmuse-emacswiki-post-library
7665 '((name . "Yaoddmuse Post library (EmacsWiki)")
7666 (init . (anything-yaoddmuse-init))
7667 (candidates-in-buffer)
7668 (action . (("Post library and Browse" . (lambda (candidate)
7669 (yaoddmuse-post-file (find-library-name candidate)
7670 "EmacsWiki"
7671 (file-name-nondirectory (find-library-name candidate))
7672 nil t)))
7673 ("Post library" . (lambda (candidate)
7674 (yaoddmuse-post-file (find-library-name candidate)
7675 "EmacsWiki"
7676 (file-name-nondirectory (find-library-name candidate))))))))
7677 "Needs yaoddmuse.el.
7679 http://www.emacswiki.org/emacs/download/yaoddmuse.el")
7681 ;; (anything 'anything-c-source-yaoddmuse-emacswiki-post-library)
7683 (defun anything-c-yaoddmuse-action-transformer (actions candidate)
7684 "Allow the use of `install-elisp' only on elisp files."
7685 (if (string-match "\.el$" candidate)
7686 (append actions '(("Install Elisp" . (lambda (elm)
7687 (install-elisp-from-emacswiki elm)))))
7688 actions))
7690 ;;;###autoload
7691 (defun anything-yaoddmuse-cache-pages (&optional load)
7692 "Fetch the list of files on emacswiki and create cache file.
7693 If load is non--nil load the file and feed `yaoddmuse-pages-hash'."
7694 (interactive)
7695 (yaoddmuse-update-pagename)
7696 (save-excursion
7697 (find-file anything-c-yaoddmuse-cache-file)
7698 (erase-buffer)
7699 (insert "(puthash \"EmacsWiki\" '(")
7700 (loop for i in (gethash "EmacsWiki" yaoddmuse-pages-hash)
7702 (insert (concat "(\"" (car i) "\") ")))
7703 (insert ") yaoddmuse-pages-hash)\n")
7704 (save-buffer)
7705 (kill-buffer (current-buffer))
7706 (when (or current-prefix-arg
7707 load)
7708 (load anything-c-yaoddmuse-cache-file))))
7710 ;;;###autoload
7711 (defun anything-yaoddmuse-emacswiki-edit-or-view ()
7712 "Preconfigured `anything' to edit or view EmacsWiki page.
7714 Needs yaoddmuse.el.
7716 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7717 (interactive)
7718 (anything 'anything-c-source-yaoddmuse-emacswiki-edit-or-view))
7720 ;;;###autoload
7721 (defun anything-yaoddmuse-emacswiki-post-library ()
7722 "Preconfigured `anything' to post library to EmacsWiki.
7724 Needs yaoddmuse.el.
7726 http://www.emacswiki.org/emacs/download/yaoddmuse.el"
7727 (interactive)
7728 (anything 'anything-c-source-yaoddmuse-emacswiki-post-library))
7730 (defun anything-yaoddmuse-init ()
7731 "Init anything buffer status."
7732 (let ((anything-buffer (anything-candidate-buffer 'global))
7733 (library-list (yaoddmuse-get-library-list)))
7734 (with-current-buffer anything-buffer
7735 ;; Insert library name.
7736 (dolist (library library-list)
7737 (insert (format "%s\n" library)))
7738 ;; Sort lines.
7739 (sort-lines nil (point-min) (point-max)))))
7741 ;;; Eev anchors
7742 (defvar anything-c-source-eev-anchor
7743 '((name . "Anchors")
7744 (candidates
7745 . (lambda ()
7746 (ignore-errors
7747 (with-current-buffer anything-current-buffer
7748 (loop initially (goto-char (point-min))
7749 while (re-search-forward (format ee-anchor-format "\\([^\.].+\\)") nil t)
7750 for anchor = (match-string-no-properties 1)
7751 collect (cons (format "%5d:%s"
7752 (line-number-at-pos (match-beginning 0))
7753 (format ee-anchor-format anchor)) anchor))))))
7754 (persistent-action . (lambda (item)
7755 (ee-to item)
7756 (anything-match-line-color-current-line)))
7757 (persistent-help . "Show this entry")
7758 (action . (("Goto link" . ee-to)))))
7759 ;; (anything 'anything-c-source-eev-anchor)
7761 ;;; Org headlines
7764 (defvar anything-c-source-org-headline
7765 '((name . "Org HeadLine")
7766 (headline "^\\*\\{1,8\\} \\(.+?\\)\\([ \t]*:[a-zA-Z0-9_@:]+:\\)?[ \t]*$")
7767 (condition . (eq major-mode 'org-mode))
7768 (migemo)
7769 (subexp . 1)
7770 (persistent-action . (lambda (elm)
7771 (anything-c-action-line-goto elm)
7772 (org-cycle)))
7773 (action-transformer
7774 . (lambda (actions candidate)
7775 '(("Go to Line" . anything-c-action-line-goto)
7776 ("Insert Link to This Headline"
7777 . anything-c-org-headline-insert-link-to-headline)))))
7778 "Show Org headlines.
7779 org-mode is very very much extended text-mode/outline-mode.
7781 See (find-library \"org.el\")
7782 See http://orgmode.org for the latest version.")
7784 (defun anything-c-org-headline-insert-link-to-headline (lineno-and-content)
7785 (insert
7786 (save-excursion
7787 (anything-goto-line (car lineno-and-content))
7788 (and (looking-at org-complex-heading-regexp)
7789 (org-make-link-string (concat "*" (match-string 4)))))))
7790 ;; (anything 'anything-c-source-org-headline)
7792 ;;; Org keywords
7795 (defvar anything-c-source-org-keywords
7796 '((name . "Org Keywords")
7797 (init . anything-c-org-keywords-init)
7798 (candidates . anything-c-org-keywords-candidates)
7799 (action . anything-c-org-keywords-insert)
7800 (persistent-action . anything-c-org-keywords-show-help)
7801 (persistent-help . "Show an example and info page to describe this keyword.")
7802 (keywords-examples)
7803 (keywords)))
7804 ;; (anything 'anything-c-source-org-keywords)
7806 (defvar anything-c-org-keywords-info-location
7807 '(("#+TITLE:" . "(org)Export options")
7808 ("#+AUTHOR:" . "(org)Export options")
7809 ("#+DATE:" . "(org)Export options")
7810 ("#+EMAIL:" . "(org)Export options")
7811 ("#+DESCRIPTION:" . "(org)Export options")
7812 ("#+KEYWORDS:" . "(org)Export options")
7813 ("#+LANGUAGE:" . "(org)Export options")
7814 ("#+TEXT:" . "(org)Export options")
7815 ("#+TEXT:" . "(org)Export options")
7816 ("#+OPTIONS:" . "(org)Export options")
7817 ("#+BIND:" . "(org)Export options")
7818 ("#+LINK_UP:" . "(org)Export options")
7819 ("#+LINK_HOME:" . "(org)Export options")
7820 ("#+LATEX_HEADER:" . "(org)Export options")
7821 ("#+EXPORT_SELECT_TAGS:" . "(org)Export options")
7822 ("#+EXPORT_EXCLUDE_TAGS:" . "(org)Export options")
7823 ("#+INFOJS_OPT" . "(org)Javascript support")
7824 ("#+BEGIN_HTML" . "(org)Quoting HTML tags")
7825 ("#+BEGIN_LaTeX" . "(org)Quoting LaTeX code")
7826 ("#+ORGTBL" . "(org)Radio tables")
7827 ("#+HTML:" . "(org)Quoting HTML tags")
7828 ("#+LaTeX:" . "(org)Quoting LaTeX code")
7829 ("#+BEGIN:" . "(org)Dynamic blocks") ;clocktable columnview
7830 ("#+BEGIN_EXAMPLE" . "(org)Literal examples")
7831 ("#+BEGIN_QUOTE" . "(org)Paragraphs")
7832 ("#+BEGIN_VERSE" . "(org)Paragraphs")
7833 ("#+BEGIN_SRC" . "(org)Literal examples")
7834 ("#+CAPTION" . "(org)Tables in HTML export")
7835 ("#+LABEL" . "(org)Tables in LaTeX export")
7836 ("#+ATTR_HTML" . "(org)Links")
7837 ("#+ATTR_LaTeX" . "(org)Images in LaTeX export")))
7839 (defun anything-c-org-keywords-init ()
7840 (unless (anything-attr 'keywords-examples)
7841 (require 'org)
7842 (anything-attrset 'keywords-examples
7843 (append
7844 (mapcar
7845 (lambda (x)
7846 (string-match "^#\\+\\(\\([A-Z_]+:?\\).*\\)" x)
7847 (cons (match-string 2 x) (match-string 1 x)))
7848 (org-split-string (org-get-current-options) "\n"))
7849 (mapcar 'list org-additional-option-like-keywords)))
7850 (anything-attrset 'keywords (mapcar 'car (anything-attr 'keywords-examples)))))
7852 (defun anything-c-org-keywords-candidates ()
7853 (and (or (eq (buffer-local-value 'major-mode anything-current-buffer) 'org-mode)
7854 (eq (buffer-local-value 'major-mode anything-current-buffer) 'message-mode))
7855 (anything-attr 'keywords)))
7857 (defun anything-c-org-keywords-insert (keyword)
7858 (cond ((and (string-match "BEGIN" keyword)
7859 (anything-region-active-p))
7860 (let ((beg (region-beginning))
7861 (end (region-end)))
7862 (goto-char end)
7863 (insert "\n#+" (replace-regexp-in-string
7864 "BEGIN" "END" keyword) "\n")
7865 (goto-char beg)
7866 (insert "#+" keyword " ")
7867 (save-excursion (insert "\n"))))
7868 ((string-match "BEGIN" keyword)
7869 (insert "#+" keyword " ")
7870 (save-excursion
7871 (insert "\n#+" (replace-regexp-in-string
7872 "BEGIN" "END" keyword) "\n")))
7873 (t (insert "#+" keyword " "))))
7875 (defun anything-c-org-keywords-show-help (keyword)
7876 (info (or (assoc-default (concat "#+" keyword) anything-c-org-keywords-info-location)
7877 "(org)In-buffer settings"))
7878 (search-forward (concat "#+" keyword) nil t)
7879 (anything-persistent-highlight-point)
7880 (message "%s" (or (cdr (assoc keyword (anything-attr 'keywords-examples))) "")))
7883 ;;; Picklist
7884 (defvar anything-c-source-picklist
7885 '((name . "Picklist")
7886 (candidates . (lambda () (mapcar 'car picklist-list)))
7887 (type . file)))
7888 ;; (anything 'anything-c-source-picklist)
7890 ;;; bbdb
7893 (defvar bbdb-records)
7894 (defvar bbdb-buffer-name)
7896 (defun anything-c-bbdb-candidates ()
7897 "Return a list of all names in the bbdb database. The format
7898 is \"Firstname Lastname\"."
7899 (mapcar (lambda (bbdb-record)
7900 (replace-regexp-in-string
7901 "\\s-+$" ""
7902 (concat (aref bbdb-record 0) " " (aref bbdb-record 1))))
7903 (bbdb-records)))
7905 (defun anything-c-bbdb-create-contact (actions candidate)
7906 "Action transformer that returns only an entry to add the
7907 current `anything-pattern' as new contact. All other actions are
7908 removed."
7909 (if (string= candidate "*Add to contacts*")
7910 '(("Add to contacts" . (lambda (actions)
7911 (bbdb-create-internal
7912 (read-from-minibuffer "Name: " anything-c-bbdb-name)
7913 (read-from-minibuffer "Company: ")
7914 (read-from-minibuffer "Email: ")
7917 (read-from-minibuffer "Note: ")))))
7918 actions))
7920 (defun anything-c-bbdb-get-record (candidate)
7921 "Return record that match CANDIDATE."
7922 (bbdb candidate nil)
7923 (set-buffer "*BBDB*")
7924 (bbdb-current-record))
7926 (defvar anything-c-bbdb-name nil
7927 "Only for internal use.")
7929 (defvar anything-c-source-bbdb
7930 '((name . "BBDB")
7931 (candidates . anything-c-bbdb-candidates)
7932 (action ("Send a mail" . anything-c-bbdb-compose-mail)
7933 ("View person's data" . anything-c-bbdb-view-person-action))
7934 (filtered-candidate-transformer . (lambda (candidates source)
7935 (setq anything-c-bbdb-name anything-pattern)
7936 (if (not candidates)
7937 (list "*Add to contacts*")
7938 candidates)))
7939 (action-transformer . (lambda (actions candidate)
7940 (anything-c-bbdb-create-contact actions candidate))))
7941 "Needs BBDB.
7943 http://bbdb.sourceforge.net/")
7944 ;; (anything 'anything-c-source-bbdb)
7946 (defun anything-c-bbdb-view-person-action (candidate)
7947 "View BBDB data of single CANDIDATE or marked candidates."
7948 (anything-aif (anything-marked-candidates)
7949 (let ((bbdb-append-records (length it)))
7950 (dolist (i it)
7951 (bbdb-redisplay-one-record (anything-c-bbdb-get-record i))))
7952 (bbdb-redisplay-one-record (anything-c-bbdb-get-record candidate))))
7954 (defun anything-c-bbdb-collect-mail-addresses ()
7955 "Return a list of all mail addresses of records in bbdb buffer."
7956 (with-current-buffer bbdb-buffer-name
7957 (loop for i in bbdb-records
7958 if (bbdb-record-net (car i))
7959 collect (bbdb-dwim-net-address (car i)))))
7961 (defun anything-c-bbdb-compose-mail (candidate)
7962 "Compose a mail with all records of bbdb buffer."
7963 (anything-c-bbdb-view-person-action candidate)
7964 (let* ((address-list (anything-c-bbdb-collect-mail-addresses))
7965 (address-str (mapconcat 'identity address-list ",\n ")))
7966 (compose-mail address-str)))
7968 ;;; Evaluation Result
7971 ;; Internal
7972 (defvar anything-eldoc-active-minibuffers-list nil)
7974 (defvar anything-c-source-evaluation-result
7975 '((name . "Evaluation Result")
7976 (disable-shortcuts)
7977 (dummy)
7978 (multiline)
7979 (mode-line . "C-RET: nl-and-indent, tab: reindent, C-tab:complete, C-p/n: next/prec-line.")
7980 (filtered-candidate-transformer . (lambda (candidates source)
7981 (list
7982 (condition-case nil
7983 (with-current-buffer anything-current-buffer
7984 (pp-to-string
7985 (eval (read anything-pattern))))
7986 (error "Error")))))
7987 (action . (("Copy result to kill-ring" . (lambda (candidate)
7988 (with-current-buffer anything-buffer
7989 (let ((end (save-excursion
7990 (goto-char (point-max))
7991 (search-backward "\n")
7992 (point))))
7993 (kill-region (point) end)))))
7994 ("copy sexp to kill-ring" . (lambda (candidate)
7995 (kill-new anything-input)))))))
7996 ;; (anything 'anything-c-source-evaluation-result)
7998 ;;;###autoload
7999 (defun anything-eval-expression (arg)
8000 "Preconfigured anything for `anything-c-source-evaluation-result'."
8001 (interactive "P")
8002 (anything :sources 'anything-c-source-evaluation-result
8003 :input (when arg (thing-at-point 'sexp))
8004 :buffer "*anything eval*"
8005 :keymap anything-eval-expression-map))
8007 (defun anything-eval-new-line-and-indent ()
8008 (interactive)
8009 (newline) (lisp-indent-line))
8011 (defun anything-eldoc-store-minibuffer ()
8012 "Store minibuffer buffer name in `anything-eldoc-active-minibuffers-list'."
8013 (with-selected-window (minibuffer-window)
8014 (push (buffer-name) anything-eldoc-active-minibuffers-list)))
8016 ;;;###autoload
8017 (defun anything-eval-expression-with-eldoc ()
8018 "Preconfigured anything for `anything-c-source-evaluation-result' with `eldoc' support. "
8019 (interactive)
8020 (declare (special eldoc-idle-delay))
8021 (let ((timer (run-with-idle-timer eldoc-idle-delay
8022 'repeat 'anything-eldoc-show-in-eval))
8023 (minibuffer-completing-symbol t) ; Enable lisp completion.
8024 (completion-cycle-threshold t)) ; Always cycle, no pesty completion buffer (emacs24 only).
8025 (unwind-protect
8026 (minibuffer-with-setup-hook
8027 'anything-eldoc-store-minibuffer
8028 (call-interactively 'anything-eval-expression))
8029 (and timer (cancel-timer timer))
8030 (setq anything-eldoc-active-minibuffers-list
8031 (cdr anything-eldoc-active-minibuffers-list)))))
8033 (defun anything-eldoc-show-in-eval ()
8034 "Return eldoc in mode-line for current minibuffer input."
8035 (let ((buf (with-selected-window (minibuffer-window)
8036 (buffer-name))))
8037 (when (member buf anything-eldoc-active-minibuffers-list)
8038 (let* ((str-all (with-current-buffer buf
8039 (minibuffer-completion-contents)))
8040 (sym (when str-all
8041 (with-temp-buffer
8042 (insert str-all)
8043 (goto-char (point-max))
8044 (unless (looking-back ")\\|\"") (forward-char -1))
8045 (eldoc-current-symbol))))
8046 (info-fn (eldoc-fnsym-in-current-sexp))
8047 (doc (or (eldoc-get-var-docstring sym)
8048 (eldoc-get-fnsym-args-string
8049 (car info-fn) (cadr info-fn)))))
8050 (when doc (funcall anything-c-eldoc-in-minibuffer-show-fn doc))))))
8052 (defun anything-c-eldoc-show-in-mode-line (str)
8053 "Show string STR in mode-line."
8054 (save-window-excursion
8055 (with-current-buffer anything-buffer
8056 (let ((mode-line-format (concat " " str)))
8057 (force-mode-line-update)
8058 (sit-for anything-c-eldoc-show-in-mode-line-delay))
8059 (force-mode-line-update))))
8061 ;;; Calculation Result
8064 (defvar anything-c-source-calculation-result
8065 '((name . "Calculation Result")
8066 (dummy)
8067 (filtered-candidate-transformer . (lambda (candidates source)
8068 (list
8069 (condition-case nil
8070 (calc-eval anything-pattern)
8071 (error "error")))))
8072 (action ("Copy result to kill-ring" . kill-new))))
8073 ;; (anything 'anything-c-source-calculation-result)
8075 ;;;###autoload
8076 (defun anything-calcul-expression ()
8077 "Preconfigured anything for `anything-c-source-calculation-result'."
8078 (interactive)
8079 (anything-other-buffer 'anything-c-source-calculation-result "*anything calcul*"))
8081 ;;; Google Suggestions
8084 ;; Internal
8085 (defvar anything-ggs-max-length-real-flag 0)
8086 (defvar anything-ggs-max-length-num-flag 0)
8088 (defun anything-c-google-suggest-fetch (input)
8089 "Fetch suggestions for INPUT from XML buffer.
8090 Return an alist with elements like (data . number_results)."
8091 (setq anything-ggs-max-length-real-flag 0
8092 anything-ggs-max-length-num-flag 0)
8093 (let ((request (concat anything-c-google-suggest-url
8094 (url-hexify-string input))))
8095 (flet ((fetch ()
8096 (loop
8097 with result-alist = (xml-get-children
8098 (car (xml-parse-region
8099 (point-min) (point-max)))
8100 'CompleteSuggestion)
8101 for i in result-alist
8102 for data = (cdr (caadr (assoc 'suggestion i)))
8103 for nqueries = (cdr (caadr (assoc 'num_queries i)))
8104 for lqueries = (length (anything-c-ggs-set-number-result
8105 nqueries))
8106 for ldata = (length data)
8108 (progn
8109 (when (> ldata anything-ggs-max-length-real-flag)
8110 (setq anything-ggs-max-length-real-flag ldata))
8111 (when (> lqueries anything-ggs-max-length-num-flag)
8112 (setq anything-ggs-max-length-num-flag lqueries)))
8113 collect (cons data nqueries) into cont
8114 finally return cont)))
8115 (if anything-google-suggest-use-curl-p
8116 (with-temp-buffer
8117 (call-process "curl" nil t nil request)
8118 (fetch))
8119 (with-current-buffer
8120 (url-retrieve-synchronously request)
8121 (fetch))))))
8123 (defun anything-c-google-suggest-set-candidates (&optional request-prefix)
8124 "Set candidates with result and number of google results found."
8125 (let ((suggestions
8126 (loop with suggested-results = (anything-c-google-suggest-fetch
8127 (or (and request-prefix
8128 (concat request-prefix " " anything-pattern))
8129 anything-pattern))
8130 for (real . numresult) in suggested-results
8131 ;; Prepare number of results with ","
8132 for fnumresult = (anything-c-ggs-set-number-result numresult)
8133 ;; Calculate number of spaces to add before fnumresult
8134 ;; if it is smaller than longest result
8135 ;; `anything-ggs-max-length-num-flag'.
8136 ;; e.g 1,234,567
8137 ;; 345,678
8138 ;; To be sure it is aligned properly.
8139 for nspaces = (if (< (length fnumresult) anything-ggs-max-length-num-flag)
8140 (- anything-ggs-max-length-num-flag (length fnumresult))
8142 ;; Add now the spaces before fnumresult.
8143 for align-fnumresult = (concat (make-string nspaces ? ) fnumresult)
8144 for interval = (- anything-ggs-max-length-real-flag (length real))
8145 for spaces = (make-string (+ 2 interval) ? )
8146 for display = (format "%s%s(%s results)" real spaces align-fnumresult)
8147 collect (cons display real))))
8148 (if (loop for (disp . dat) in suggestions
8149 thereis (equal dat anything-pattern))
8150 suggestions
8151 ;; if there is no suggestion exactly matching the input then
8152 ;; prepend a Search on Google item to the list
8153 (append
8154 suggestions
8155 (list (cons (concat "Search for " "'" anything-input "'" " on Google")
8156 anything-input))))))
8158 (defun anything-c-ggs-set-number-result (num)
8159 (if num
8160 (progn
8161 (and (numberp num) (setq num (number-to-string num)))
8162 (loop for i in (reverse (split-string num "" t))
8163 for count from 1
8164 append (list i) into C
8165 when (= count 3)
8166 append (list ",") into C
8167 and do (setq count 0)
8168 finally return
8169 (replace-regexp-in-string
8170 "^," "" (mapconcat 'identity (reverse C) ""))))
8171 "?"))
8173 (defvar anything-c-google-suggest-default-browser-function nil
8174 "*The browse url function you prefer to use with google suggest.
8175 When nil, use the first browser function available
8176 See `anything-browse-url-default-browser-alist'.")
8178 (defun anything-c-google-suggest-action (candidate)
8179 "Default action to jump to a google suggested candidate."
8180 (let ((arg (concat anything-c-google-suggest-search-url
8181 (url-hexify-string candidate))))
8182 (anything-aif anything-c-google-suggest-default-browser-function
8183 (funcall it arg)
8184 (anything-c-browse-url arg))))
8186 (defvar anything-c-google-suggest-default-function
8187 'anything-c-google-suggest-set-candidates
8188 "Default function to use in anything google suggest.")
8190 (defvar anything-c-source-google-suggest
8191 '((name . "Google Suggest")
8192 (candidates . (lambda ()
8193 (funcall anything-c-google-suggest-default-function)))
8194 (action . (("Google Search" . anything-c-google-suggest-action)))
8195 (volatile)
8196 (requires-pattern . 3)
8197 (delayed)))
8199 (defun anything-c-google-suggest-emacs-lisp ()
8200 "Try to emacs lisp complete with google suggestions."
8201 (anything-c-google-suggest-set-candidates "emacs lisp"))
8203 ;; (anything 'anything-c-source-google-suggest)
8205 ;;; Yahoo suggestions
8208 (defun anything-c-yahoo-suggest-fetch (input)
8209 "Fetch Yahoo suggestions for INPUT from XML buffer.
8210 Return an alist with elements like (data . number_results)."
8211 (let ((request (concat anything-c-yahoo-suggest-url
8212 (url-hexify-string input))))
8213 (flet ((fetch ()
8214 (loop
8215 with result-alist = (xml-get-children
8216 (car (xml-parse-region (point-min) (point-max)))
8217 'Result)
8218 for i in result-alist
8219 collect (caddr i))))
8220 (with-current-buffer
8221 (url-retrieve-synchronously request)
8222 (fetch)))))
8224 (defun anything-c-yahoo-suggest-set-candidates ()
8225 "Set candidates with Yahoo results found."
8226 (let ((suggestions (anything-c-yahoo-suggest-fetch anything-input)))
8227 (or suggestions
8228 (append
8229 suggestions
8230 (list (cons (concat "Search for " "'" anything-input "'" " on Yahoo")
8231 anything-input))))))
8233 (defun anything-c-yahoo-suggest-action (candidate)
8234 "Default action to jump to a Yahoo suggested candidate."
8235 (anything-c-browse-url (concat anything-c-yahoo-suggest-search-url
8236 (url-hexify-string candidate))))
8238 (defvar anything-c-source-yahoo-suggest
8239 '((name . "Yahoo Suggest")
8240 (candidates . anything-c-yahoo-suggest-set-candidates)
8241 (action . (("Yahoo Search" . anything-c-yahoo-suggest-action)))
8242 (volatile)
8243 (requires-pattern . 3)
8244 (delayed)))
8246 ;; (anything 'anything-c-source-yahoo-suggest)
8248 ;;; Web browser functions.
8251 (require 'browse-url)
8252 ;; If default setting of `w3m-command' is not
8253 ;; what you want you and you modify it, you will have to reeval
8254 ;; also `anything-browse-url-default-browser-alist'.
8255 (defvar w3m-command "/usr/bin/w3m")
8256 (defvar anything-c-home-url "http://www.google.fr"
8257 "*Default url to use as home url.")
8259 (defvar browse-url-chromium-program "chromium-browser")
8260 (defvar browse-url-uzbl-program "uzbl-browser")
8261 (defvar anything-browse-url-default-browser-alist
8262 `((,w3m-command . w3m-browse-url)
8263 (,browse-url-firefox-program . browse-url-firefox)
8264 (,browse-url-chromium-program . browse-url-chromium)
8265 (,browse-url-uzbl-program . browse-url-uzbl)
8266 (,browse-url-kde-program . browse-url-kde)
8267 (,browse-url-gnome-moz-program . browse-url-gnome-moz)
8268 (,browse-url-mozilla-program . browse-url-mozilla)
8269 (,browse-url-galeon-program . browse-url-galeon)
8270 (,browse-url-netscape-program . browse-url-netscape)
8271 (,browse-url-mosaic-program . browse-url-mosaic)
8272 (,browse-url-xterm-program . browse-url-text-xterm))
8273 "*Alist of (executable . function) to try to find a suitable url browser.")
8275 (defun* anything-c-generic-browser (url name &rest args)
8276 "Browse URL with NAME browser."
8277 (let ((proc (concat name " " url)))
8278 (message "Starting %s..." name)
8279 (apply 'start-process proc nil name
8280 (append args (list url)))
8281 (set-process-sentinel
8282 (get-process proc)
8283 #'(lambda (process event)
8284 (when (string= event "finished\n")
8285 (message "%s process %s" process event))))))
8287 (defun browse-url-chromium (url)
8288 "Browse URL with google chrome browser."
8289 (interactive "sURL: ")
8290 (anything-c-generic-browser
8291 url browse-url-chromium-program))
8293 (defun browse-url-uzbl (url &optional ignore)
8294 "Browse URL with uzbl browser."
8295 (interactive "sURL: ")
8296 (anything-c-generic-browser url browse-url-uzbl-program "-u"))
8298 (defun anything-browse-url-default-browser (url &rest args)
8299 "Find the first available browser and ask it to load URL."
8300 (let ((default-browser-fn
8301 (loop for (exe . fn) in anything-browse-url-default-browser-alist
8302 thereis (and exe (executable-find exe) fn))))
8303 (if default-browser-fn
8304 (apply default-browser-fn url args)
8305 (error "No usable browser found"))))
8307 (defun* anything-c-browse-url (&optional (url anything-c-home-url))
8308 "Default command to browse URL."
8309 (if browse-url-browser-function
8310 (browse-url url)
8311 (anything-browse-url-default-browser url)))
8313 ;;; Surfraw
8315 ;; Need external program surfraw.
8316 ;; <http://surfraw.alioth.debian.org/>
8318 (defvar anything-surfraw-default-browser-function nil
8319 "*The browse url function you prefer to use with surfraw.
8320 When nil, fallback to `browse-url-browser-function'.")
8322 ;; Internal
8323 (defvar anything-surfraw-engines-history nil)
8325 (defun anything-c-build-elvi-list ()
8326 "Return list of all engines and descriptions handled by surfraw."
8327 (cdr
8328 (with-temp-buffer
8329 (call-process "surfraw" nil t nil
8330 "-elvi")
8331 (split-string (buffer-string) "\n"))))
8333 ;;;###autoload
8334 (defun anything-surfraw (pattern engine)
8335 "Preconfigured `anything' to search PATTERN with search ENGINE."
8336 (interactive (list (read-string "SearchFor: ")
8337 (anything-comp-read
8338 "Engine: "
8339 (anything-c-build-elvi-list)
8340 :must-match t
8341 :name "Surfraw Search Engines"
8342 :history anything-surfraw-engines-history)))
8343 (let* ((engine-nodesc (car (split-string engine)))
8344 (url (shell-command-to-string
8345 (format "surfraw %s -p %s"
8346 engine-nodesc pattern)))
8347 (browse-url-browser-function
8348 (or anything-surfraw-default-browser-function
8349 browse-url-browser-function)))
8350 (if (string= engine-nodesc "W")
8351 (anything-c-browse-url)
8352 (anything-c-browse-url url)
8353 (setq anything-surfraw-engines-history
8354 (cons engine (delete engine anything-surfraw-engines-history))))))
8356 ;;; Emms
8359 (defun anything-emms-stream-edit-bookmark (elm)
8360 "Change the information of current emms-stream bookmark from anything."
8361 (declare (special emms-stream-list))
8362 (let* ((cur-buf anything-current-buffer)
8363 (bookmark (assoc elm emms-stream-list))
8364 (name (read-from-minibuffer "Description: "
8365 (nth 0 bookmark)))
8366 (url (read-from-minibuffer "URL: "
8367 (nth 1 bookmark)))
8368 (fd (read-from-minibuffer "Feed Descriptor: "
8369 (int-to-string (nth 2 bookmark))))
8370 (type (read-from-minibuffer "Type (url, streamlist, or lastfm): "
8371 (format "%s" (car (last bookmark))))))
8372 (save-excursion
8373 (emms-streams)
8374 (when (re-search-forward (concat "^" name) nil t)
8375 (beginning-of-line)
8376 (emms-stream-delete-bookmark)
8377 (emms-stream-add-bookmark name url (string-to-number fd) type)
8378 (emms-stream-save-bookmarks-file)
8379 (emms-stream-quit)
8380 (anything-c-switch-to-buffer cur-buf)))))
8382 (defun anything-emms-stream-delete-bookmark (elm)
8383 "Delete an emms-stream bookmark from anything."
8384 (let* ((cur-buf anything-current-buffer)
8385 (bookmark (assoc elm emms-stream-list))
8386 (name (nth 0 bookmark)))
8387 (save-excursion
8388 (emms-streams)
8389 (when (re-search-forward (concat "^" name) nil t)
8390 (beginning-of-line)
8391 (emms-stream-delete-bookmark)
8392 (emms-stream-save-bookmarks-file)
8393 (emms-stream-quit)
8394 (anything-c-switch-to-buffer cur-buf)))))
8396 (defvar anything-c-source-emms-streams
8397 '((name . "Emms Streams")
8398 (init . (lambda ()
8399 (emms-stream-init)))
8400 (candidates . (lambda ()
8401 (mapcar 'car emms-stream-list)))
8402 (action . (("Play" . (lambda (elm)
8403 (let* ((stream (assoc elm emms-stream-list))
8404 (fn (intern (concat "emms-play-" (symbol-name (car (last stream))))))
8405 (url (second stream)))
8406 (funcall fn url))))
8407 ("Delete" . anything-emms-stream-delete-bookmark)
8408 ("Edit" . anything-emms-stream-edit-bookmark)))
8409 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8410 ;; (anything 'anything-c-source-emms-streams)
8412 ;; Don't forget to set `emms-source-file-default-directory'
8413 (defvar anything-c-source-emms-dired
8414 '((name . "Music Directory")
8415 (candidates . (lambda ()
8416 (cddr (directory-files emms-source-file-default-directory))))
8417 (action .
8418 (("Play Directory" . (lambda (item)
8419 (emms-play-directory
8420 (expand-file-name
8421 item
8422 emms-source-file-default-directory))))
8423 ("Open dired in file's directory" . (lambda (item)
8424 (anything-c-open-dired
8425 (expand-file-name
8426 item
8427 emms-source-file-default-directory))))))
8428 (filtered-candidate-transformer . anything-c-adaptive-sort)))
8429 ;; (anything 'anything-c-source-emms-dired)
8432 (defun anything-c-emms-files-modifier (candidates source)
8433 (let ((current-playlist (with-current-emms-playlist
8434 (loop
8435 with cur-list = (emms-playlist-tracks-in-region
8436 (point-min) (point-max))
8437 for i in cur-list
8438 collect (assoc-default 'name i)))))
8439 (loop for i in candidates
8440 if (member (cdr i) current-playlist)
8441 collect (cons (propertize (car i)
8442 'face 'anything-emms-playlist)
8443 (cdr i)) into lis
8444 else collect i into lis
8445 finally return lis)))
8447 (defun anything-c-emms-play-current-playlist ()
8448 "Play current playlist."
8449 (with-current-emms-playlist
8450 (emms-playlist-first)
8451 (emms-playlist-mode-play-smart)))
8453 (defvar anything-c-source-emms-files
8454 '((name . "Emms files")
8455 (candidates . (lambda ()
8456 (loop for v being the hash-values in emms-cache-db
8457 for name = (assoc-default 'name v)
8458 for artist = (or (assoc-default 'info-artist v) "unknown")
8459 for genre = (or (assoc-default 'info-genre v) "unknown")
8460 for tracknum = (or (assoc-default 'info-tracknumber v) "unknown")
8461 for song = (or (assoc-default 'info-title v) "unknown")
8462 for info = (concat artist " - " genre " - " tracknum ": " song)
8463 unless (string-match "^http:" name) collect (cons info name))))
8464 (filtered-candidate-transformer . anything-c-emms-files-modifier)
8465 (action . (("Play file" . emms-play-file)
8466 ("Add to Playlist and play (C-u clear current)"
8467 . (lambda (candidate)
8468 (when anything-current-prefix-arg
8469 (emms-playlist-current-clear))
8470 (emms-playlist-new)
8471 (mapc 'emms-add-playlist-file (anything-marked-candidates))
8472 (unless emms-player-playing-p
8473 (anything-c-emms-play-current-playlist))))))))
8475 ;; (anything 'anything-c-source-emms-files)
8477 ;;; Jabber Contacts (jabber.el)
8478 (defun anything-c-jabber-online-contacts ()
8479 "List online Jabber contacts."
8480 (with-no-warnings
8481 (let (jids)
8482 (dolist (item (jabber-concat-rosters) jids)
8483 (when (get item 'connected)
8484 (push (if (get item 'name)
8485 (cons (get item 'name) item)
8486 (cons (symbol-name item) item)) jids))))))
8488 (defvar anything-c-source-jabber-contacts
8489 '((name . "Jabber Contacts")
8490 (init . (lambda () (require 'jabber)))
8491 (candidates . (lambda () (mapcar 'car (anything-c-jabber-online-contacts))))
8492 (action . (lambda (x)
8493 (jabber-chat-with
8494 (jabber-read-account)
8495 (symbol-name
8496 (cdr (assoc x (anything-c-jabber-online-contacts)))))))))
8497 ;; (anything 'anything-c-source-jabber-contacts)
8500 ;;; Call source.
8501 (defvar anything-source-select-buffer "*anything source select*")
8502 (defvar anything-c-source-call-source
8503 `((name . "Call anything source")
8504 (candidate-number-limit)
8505 (candidates . (lambda ()
8506 (loop for vname in (all-completions "anything-c-source-" obarray)
8507 for var = (intern vname)
8508 for name = (ignore-errors (assoc-default 'name (symbol-value var)))
8509 if name collect (cons (format "%s `%s'"
8510 name (propertize vname 'face 'font-lock-variable-name-face))
8511 var))))
8512 (action . (("Invoke anything with selected source" .
8513 (lambda (candidate)
8514 (setq anything-candidate-number-limit 9999)
8515 (anything candidate nil nil nil nil
8516 anything-source-select-buffer)))
8517 ("Describe variable" . describe-variable)
8518 ("Find variable" . find-variable)))
8519 (persistent-action . describe-variable)
8520 (persistent-help . "Show description of this source")))
8521 ;; (anything 'anything-c-source-call-source)
8523 ;;;###autoload
8524 (defun anything-call-source ()
8525 "Preconfigured `anything' to call anything source."
8526 (interactive)
8527 (anything 'anything-c-source-call-source nil nil nil nil
8528 anything-source-select-buffer))
8530 (defun anything-call-source-from-anything ()
8531 "Call anything source within `anything' session."
8532 (interactive)
8533 (setq anything-input-idle-delay 0)
8534 (anything-set-sources '(anything-c-source-call-source)))
8536 ;;; Execute Preconfigured anything.
8537 (defvar anything-c-source-anything-commands
8538 '((name . "Preconfigured Anything")
8539 (candidates . anything-c-anything-commands-candidates)
8540 (type . command)
8541 (candidate-number-limit)))
8542 ;; (anything 'anything-c-source-anything-commands)
8544 (defun anything-c-anything-commands-candidates ()
8545 (loop for (cmd . desc) in (anything-c-list-preconfigured-anything)
8546 collect (cons (if (where-is-internal cmd nil t)
8547 (substitute-command-keys (format "M-x %s (\\[%s]) : %s" cmd cmd desc))
8548 (substitute-command-keys (format "\\[%s] : %s" cmd desc)))
8549 cmd)))
8551 ;;;###autoload
8552 (defun anything-execute-anything-command ()
8553 "Preconfigured `anything' to execute preconfigured `anything'."
8554 (interactive)
8555 (anything-other-buffer 'anything-c-source-anything-commands
8556 "*anything commands*"))
8558 ;;; Occur
8561 (defun anything-c-occur-init ()
8562 "Create the initial anything occur buffer.
8563 If region is active use region as buffer contents
8564 instead of whole buffer."
8565 (with-current-buffer (anything-candidate-buffer 'global)
8566 (erase-buffer)
8567 (let ((buf-contents
8568 (with-current-buffer anything-current-buffer
8569 (if (anything-region-active-p)
8570 (buffer-substring (region-beginning) (region-end))
8571 (buffer-substring (point-min) (point-max))))))
8572 (insert buf-contents))))
8574 (defun anything-c-occur-get-line (s e)
8575 (format "%7d:%s" (line-number-at-pos (1- s)) (buffer-substring s e)))
8577 (defun anything-c-occur-query-replace-regexp (candidate)
8578 "Query replace regexp starting from CANDIDATE.
8579 If region is active ignore CANDIDATE and replace only in region.
8580 With a prefix arg replace only matches surrounded by word boundaries,
8581 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
8582 (let ((regexp anything-input))
8583 (unless (anything-region-active-p)
8584 (anything-c-action-line-goto candidate))
8585 (apply 'query-replace-regexp
8586 (anything-c-query-replace-args regexp))))
8588 (defvar anything-c-source-occur
8589 '((name . "Occur")
8590 (init . anything-c-occur-init)
8591 (candidates-in-buffer)
8592 (migemo)
8593 (get-line . anything-c-occur-get-line)
8594 (display-to-real . anything-c-display-to-real-line)
8595 (action . (("Go to Line" . anything-c-action-line-goto)
8596 ("Query replace regexp (C-u Not inside word.)"
8597 . anything-c-occur-query-replace-regexp)))
8598 (recenter)
8599 (requires-pattern . 1)
8600 (delayed)
8601 (volatile)))
8602 ;; (anything 'anything-c-source-occur)
8604 ;;; Anything browse code.
8605 (defun anything-c-browse-code-get-line (beg end)
8606 "Select line if it match the regexp corresponding to current `major-mode'.
8607 Line is parsed for BEG position to END position."
8608 (let ((str-line (buffer-substring beg end))
8609 (regexp (assoc-default major-mode
8610 anything-c-browse-code-regexp-alist))
8611 (num-line (if (string= anything-pattern "") beg (1- beg))))
8612 (when (and regexp (string-match regexp str-line))
8613 (format "%4d:%s" (line-number-at-pos num-line) str-line))))
8616 (defvar anything-c-source-browse-code
8617 '((name . "Browse code")
8618 (init . (lambda ()
8619 (anything-candidate-buffer anything-current-buffer)
8620 (with-current-buffer anything-current-buffer
8621 (jit-lock-fontify-now))))
8622 (candidate-number-limit . 9999)
8623 (candidates-in-buffer)
8624 (get-line . anything-c-browse-code-get-line)
8625 (type . line)
8626 (recenter)))
8628 ;; Do many actions for input
8629 (defvar anything-c-source-create
8630 '((name . "Create")
8631 (dummy)
8632 (action)
8633 (action-transformer . anything-create--actions))
8634 "Do many create actions from `anything-pattern'.
8635 See also `anything-create--actions'.")
8636 ;; (anything 'anything-c-source-create)
8638 (defun anything-create-from-anything ()
8639 "Run `anything-create' from `anything' as a fallback."
8640 (interactive)
8641 (anything-run-after-quit 'anything-create nil anything-pattern))
8643 ;;;###autoload
8644 (defun anything-create (&optional string initial-input)
8645 "Preconfigured `anything' to do many create actions from STRING.
8646 See also `anything-create--actions'."
8647 (interactive)
8648 (setq string (or string (read-string "Create Anything: " initial-input)))
8649 (anything '(((name . "Anything Create")
8650 (header-name . (lambda (_) (format "Action for \"%s\"" string)))
8651 (candidates . anything-create--actions)
8652 (candidate-number-limit)
8653 (action . (lambda (func) (funcall func string)))))))
8655 (defun anything-create--actions (&rest ignored)
8656 "Default actions for `anything-create' / `anything-c-source-create'."
8657 (remove-if-not
8658 (lambda (pair) (and (consp pair) (functionp (cdr pair))))
8659 (append anything-create--actions-private
8660 '(("find-file" . find-file)
8661 ("find-file other window" . find-file-other-window)
8662 ("New buffer" . anything-c-switch-to-buffer)
8663 ("New buffer other window" . switch-to-buffer-other-window)
8664 ("Bookmark Set" . bookmark-set)
8665 ("Set Register" .
8666 (lambda (x) (set-register (read-char "Register: ") x)))
8667 ("Insert Linkd star" . linkd-insert-star)
8668 ("Insert Linkd Tag" . linkd-insert-tag)
8669 ("Insert Linkd Link" . linkd-insert-link)
8670 ("Insert Linkd Lisp" . linkd-insert-lisp)
8671 ("Insert Linkd Wiki" . linkd-insert-wiki)
8672 ("Google Search" . google)))))
8674 ;; Minibuffer History
8675 (defvar anything-c-source-minibuffer-history
8676 '((name . "Minibuffer History")
8677 (header-name . (lambda (name) (format "%s (%s)" name minibuffer-history-variable)))
8678 (candidates
8679 . (lambda ()
8680 (let ((history (loop
8681 for i in (symbol-value minibuffer-history-variable)
8682 unless (string= "" i) collect i)))
8683 (if (consp (car history))
8684 (mapcar 'prin1-to-string history)
8685 history))))
8686 (migemo)
8687 (action . insert)))
8688 ;; (anything 'anything-c-source-minibuffer-history)
8690 ;; elscreen
8691 (defvar anything-c-source-elscreen
8692 '((name . "Elscreen")
8693 (candidates . (lambda ()
8694 (if (cdr (elscreen-get-screen-to-name-alist))
8695 (sort
8696 (loop for sname in (elscreen-get-screen-to-name-alist)
8697 append (list (format "[%d] %s" (car sname) (cdr sname))) into lst
8698 finally (return lst))
8699 #'(lambda (a b) (compare-strings a nil nil b nil nil))))))
8700 (action . (("Change Screen".
8701 (lambda (candidate)
8702 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))))
8703 ("Kill Screen(s)".
8704 (lambda (candidate)
8705 (dolist (i (anything-marked-candidates))
8706 (elscreen-goto (- (aref i 1) (aref "0" 0)))
8707 (elscreen-kill))))
8708 ("Only Screen".
8709 (lambda (candidate)
8710 (elscreen-goto (- (aref candidate 1) (aref "0" 0)))
8711 (elscreen-kill-others)))))))
8712 ;; (anything 'anything-c-source-elscreen)
8714 ;;;; <System>
8716 ;;; Top (process)
8717 (defvar anything-c-top-command "COLUMNS=%s top -b -n 1"
8718 "Top command (batch mode). %s is replaced with `frame-width'.")
8719 (defvar anything-c-source-top
8720 '((name . "Top (Press C-c C-u to refresh)")
8721 (init . anything-c-top-init)
8722 (candidates-in-buffer)
8723 (display-to-real . anything-c-top-display-to-real)
8724 (update . anything-c-top-update)
8725 (persistent-action . anything-c-top-sh-persistent-action)
8726 (persistent-help . "SIGTERM")
8727 (action
8728 ("kill (TERM)" . (lambda (pid) (anything-c-top-sh (format "kill -TERM %s" pid))))
8729 ("kill (KILL)" . (lambda (pid) (anything-c-top-sh (format "kill -KILL %s" pid))))
8730 ("Copy PID" . (lambda (pid) (kill-new pid))))))
8731 ;; (anything 'anything-c-source-top)
8733 (defun anything-c-top-sh (cmd)
8734 (message "Executed %s\n%s" cmd (shell-command-to-string cmd)))
8736 (defun anything-c-top-sh-persistent-action (pid)
8737 (delete-other-windows)
8738 (anything-c-top-sh (format "kill -TERM %s" pid))
8739 (anything-force-update))
8741 (defun anything-c-top-init ()
8742 (with-current-buffer (anything-candidate-buffer 'global)
8743 (call-process-shell-command
8744 (format anything-c-top-command
8745 (- (frame-width) (if anything-enable-digit-shortcuts 4 0)))
8746 nil (current-buffer))))
8748 (defun anything-c-top-display-to-real (line)
8749 (car (split-string line)))
8751 (defun anything-c-top-update ()
8752 (let ((anything-source-name (assoc-default 'name anything-c-source-top))) ;UGLY HACK
8753 (anything-c-top-init)))
8755 ;;;###autoload
8756 (defun anything-top ()
8757 "Preconfigured `anything' for top command."
8758 (interactive)
8759 (let ((anything-samewindow t)
8760 (anything-enable-shortcuts)
8761 (anything-display-function 'anything-default-display-buffer)
8762 (anything-candidate-number-limit 9999))
8763 (save-window-excursion
8764 (delete-other-windows)
8765 (anything-other-buffer 'anything-c-source-top "*anything top*"))))
8767 ;;; Timers
8768 (defvar anything-c-source-absolute-time-timers
8769 '((name . "Absolute Time Timers")
8770 (candidates . timer-list)
8771 (type . timer)))
8772 ;; (anything 'anything-c-source-absolute-time-timers)
8774 (defvar anything-c-source-idle-time-timers
8775 '((name . "Idle Time Timers")
8776 (candidates . timer-idle-list)
8777 (type . timer)))
8778 ;; (anything 'anything-c-source-idle-time-timers)
8780 (defun anything-c-timer-real-to-display (timer)
8781 (destructuring-bind (triggered t1 t2 t3 repeat-delay func args idle-delay)
8782 (append timer nil) ;use `append' to convert vector->list
8783 (format "%s repeat=%5S %s(%s)"
8784 (let ((time (list t1 t2 t3)))
8785 (if idle-delay
8786 (format-time-string "idle-for=%5s" time)
8787 (format-time-string "%m/%d %T" time)))
8788 repeat-delay
8789 func
8790 (mapconcat 'prin1-to-string args " "))))
8792 ;;; X RandR resolution change
8793 ;;; FIXME I do not care multi-display.
8794 (defvar anything-c-xrandr-output "VGA")
8795 (defvar anything-c-xrandr-screen "0")
8796 (defvar anything-c-source-xrandr-change-resolution
8797 '((name . "Change Resolution")
8798 (candidates
8799 . (lambda ()
8800 (with-temp-buffer
8801 (call-process "xrandr" nil (current-buffer) nil
8802 "--screen" anything-c-xrandr-screen "-q")
8803 (goto-char 1)
8804 (loop while (re-search-forward " \\([0-9]+x[0-9]+\\)" nil t)
8805 collect (match-string 1)))))
8806 (action
8807 ("Change Resolution" . (lambda (mode)
8808 (call-process "xrandr" nil nil nil
8809 "--screen" anything-c-xrandr-screen
8810 "--output" anything-c-xrandr-output
8811 "--mode" mode))))))
8812 ;; (anything 'anything-c-source-xrandr-change-resolution)
8814 ;;; Xfont selection
8817 (defun anything-c-persistent-xfont-action (elm)
8818 "Show current font temporarily"
8819 (let ((current-font (cdr (assoc 'font (frame-parameters))))
8820 (default-font elm))
8821 (unwind-protect
8822 (progn (set-frame-font default-font 'keep-size) (sit-for 2))
8823 (set-frame-font current-font))))
8825 (defvar anything-c-xfonts-cache nil)
8826 (defvar anything-c-source-xfonts
8827 '((name . "X Fonts")
8828 (init . (lambda ()
8829 (unless anything-c-xfonts-cache
8830 (setq anything-c-xfonts-cache
8831 (x-list-fonts "*")))))
8832 (candidates . anything-c-xfonts-cache)
8833 (action . (("Copy to kill ring" . (lambda (elm)
8834 (kill-new elm)))
8835 ("Set Font" . (lambda (elm)
8836 (kill-new elm)
8837 (set-frame-font elm 'keep-size)
8838 (message "New font have been copied to kill ring")))))
8839 (persistent-action . anything-c-persistent-xfont-action)
8840 (persistent-help . "Switch to this font temporarily")))
8842 ;;;###autoload
8843 (defun anything-select-xfont ()
8844 "Preconfigured `anything' to select Xfont."
8845 (interactive)
8846 (anything-other-buffer 'anything-c-source-xfonts "*anything select* xfont"))
8848 ;; (anything 'anything-c-source-xfonts)
8850 ;;; World time
8853 (defvar anything-c-source-time-world
8854 '((name . "Time World List")
8855 (init . (lambda ()
8856 (let ((anything-buffer (anything-candidate-buffer 'global)))
8857 (with-current-buffer anything-buffer
8858 (display-time-world-display display-time-world-list)))))
8859 (candidates-in-buffer)))
8861 ;;;###autoload
8862 (defun anything-world-time ()
8863 "Preconfigured `anything' to show world time."
8864 (interactive)
8865 (anything-other-buffer 'anything-c-source-time-world "*anything world time*"))
8867 ;;; Anything interface for Debian/Ubuntu packages (apt-*)
8870 (defvar anything-c-source-apt
8871 '((name . "APT")
8872 (init . anything-c-apt-init)
8873 (candidates-in-buffer)
8874 (candidate-transformer anything-c-apt-candidate-transformer)
8875 (display-to-real . anything-c-apt-display-to-real)
8876 (requires-pattern . 2)
8877 (delayed)
8878 (action
8879 ("Show package description" . anything-c-apt-cache-show)
8880 ("Install package" . anything-c-apt-install)
8881 ("Remove package" . anything-c-apt-uninstall)
8882 ("Purge package" . anything-c-apt-purge))
8883 (persistent-action . anything-c-apt-persistent-action)
8884 (persistent-help . "Show - C-u Refresh")))
8885 ;; (anything 'anything-c-source-apt)
8887 (defvar anything-c-apt-query "emacs")
8888 (defvar anything-c-apt-search-command "apt-cache search '%s'")
8889 (defvar anything-c-apt-show-command "apt-cache show '%s'")
8890 (defvar anything-c-apt-installed-packages nil)
8891 (defvar anything-c-apt-all-packages nil)
8894 (defun anything-c-apt-refresh ()
8895 "Refresh installed candidates list."
8896 (setq anything-c-apt-installed-packages nil)
8897 (setq anything-c-apt-all-packages nil)
8898 (anything-force-update))
8900 (defun anything-c-apt-persistent-action (candidate)
8901 "Persistent action for APT source."
8902 (if current-prefix-arg
8903 (anything-c-apt-refresh)
8904 (anything-c-apt-cache-show candidate)))
8906 ;;;###autoload
8907 (defun anything-apt (arg query)
8908 "Preconfigured `anything' : frontend of APT package manager.
8909 With a prefix arg reload cache."
8910 (interactive "P\nsSearch Package: ")
8911 (when arg
8912 (setq anything-c-apt-installed-packages nil)
8913 (setq anything-c-apt-all-packages nil))
8914 (anything :sources 'anything-c-source-apt
8915 :prompt "Search Package: " :input query))
8917 (defun anything-c-apt-candidate-transformer (candidates)
8918 "Show installed candidates in a different color."
8919 (loop
8920 with all
8921 for cand in candidates
8922 for name = (anything-c-apt-display-to-real cand)
8923 if (member name anything-c-apt-installed-packages)
8924 collect (propertize cand 'face 'anything-apt-installed) into all
8925 else collect cand into all finally return all))
8927 (defun anything-c-apt-init ()
8928 "Initialize list of debian packages."
8929 (let ((query ""))
8930 (unless (and anything-c-apt-installed-packages
8931 anything-c-apt-all-packages)
8932 (message "Loading package list...")
8933 (setq anything-c-apt-installed-packages
8934 (with-temp-buffer
8935 (call-process-shell-command "dpkg --get-selections"
8936 nil (current-buffer))
8937 (loop for i in (split-string (buffer-string) "\n" t)
8938 collect (car (split-string i)))))
8939 (setq anything-c-apt-all-packages
8940 (with-current-buffer
8941 (anything-candidate-buffer
8942 (get-buffer-create (format "*anything-apt*")))
8943 (erase-buffer)
8944 (call-process-shell-command
8945 (format anything-c-apt-search-command query)
8946 nil (current-buffer))))
8947 (message "Loading package list done")
8948 (sit-for 0.5))))
8950 (defun anything-c-apt-display-to-real (line)
8951 "Return only name of a debian package.
8952 LINE is displayed like:
8953 package name - description."
8954 (car (split-string line " - ")))
8956 (defun anything-c-shell-command-if-needed (command)
8957 "Run shell command COMMAND to describe package.
8958 If a buffer named COMMAND already exists, just switch to it."
8959 (let ((buf (get-buffer command)))
8960 (anything-c-switch-to-buffer (get-buffer-create command))
8961 (unless buf (insert (shell-command-to-string command)))))
8963 (defun anything-c-apt-cache-show (package)
8964 "Show information on apt package PACKAGE."
8965 (anything-c-shell-command-if-needed
8966 (format anything-c-apt-show-command package)))
8968 (defun anything-c-apt-install (package)
8969 "Run 'apt-get install' shell command on PACKAGE."
8970 (anything-c-apt-generic-action :action 'install))
8972 (defun anything-c-apt-uninstall (package)
8973 "Run 'apt-get remove' shell command on PACKAGE."
8974 (anything-c-apt-generic-action :action 'uninstall))
8976 (defun anything-c-apt-purge (package)
8977 "Run 'apt-get purge' shell command on PACKAGE."
8978 (anything-c-apt-generic-action :action 'purge))
8980 (defun* anything-c-apt-generic-action (&key action)
8981 "Run 'apt-get ACTION'.
8982 Support install, remove and purge actions."
8983 (ansi-term (getenv "SHELL") "anything apt")
8984 (term-line-mode)
8985 (let ((command (case action
8986 ('install "sudo apt-get install ")
8987 ('uninstall "sudo apt-get remove ")
8988 ('purge "sudo apt-get purge ")
8989 (t (error "Unknow action"))))
8990 (beg (point))
8992 (cand-list (mapconcat #'(lambda (x) (format "'%s'" x))
8993 (anything-marked-candidates) " ")))
8994 (goto-char (point-max))
8995 (insert (concat command cand-list))
8996 (setq end (point))
8997 (if (y-or-n-p (format "%s package" (symbol-name action)))
8998 (progn
8999 (setq anything-c-external-commands-list nil)
9000 (setq anything-c-apt-installed-packages nil)
9001 (term-char-mode) (term-send-input))
9002 (delete-region beg end) (term-send-eof) (kill-buffer))))
9004 ;; (anything-c-apt-install "jed")
9006 ;;; Sources for gentoo users
9007 (defvar anything-c-gentoo-use-flags nil)
9008 (defvar anything-c-gentoo-buffer "*anything-gentoo-output*")
9009 (defvar anything-c-cache-gentoo nil)
9010 (defvar anything-c-cache-world nil)
9011 (defvar anything-c-source-gentoo
9012 '((name . "Portage sources")
9013 (init . (lambda ()
9014 (get-buffer-create anything-c-gentoo-buffer)
9015 (unless anything-c-cache-gentoo
9016 (anything-c-gentoo-setup-cache))
9017 (unless anything-c-cache-world
9018 (setq anything-c-cache-world (anything-c-gentoo-get-world)))
9019 (anything-c-gentoo-init-list)))
9020 (candidates-in-buffer)
9021 (match . identity)
9022 (candidate-transformer anything-c-highlight-world)
9023 (action . (("Show package" . (lambda (elm)
9024 (anything-c-gentoo-eshell-action elm "eix")))
9025 ("Show history" . (lambda (elm)
9026 (if (member elm anything-c-cache-world)
9027 (anything-c-gentoo-eshell-action elm "genlop -qe")
9028 (message "No infos on packages not yet installed"))))
9029 ("Copy in kill-ring" . kill-new)
9030 ("insert at point" . insert)
9031 ("Browse HomePage" . (lambda (elm)
9032 (let ((urls (anything-c-gentoo-get-url elm)))
9033 (browse-url (anything-comp-read "Url: " urls :must-match t)))))
9034 ("Show extra infos" . (lambda (elm)
9035 (if (member elm anything-c-cache-world)
9036 (anything-c-gentoo-eshell-action elm "genlop -qi")
9037 (message "No infos on packages not yet installed"))))
9038 ("Show use flags" . (lambda (elm)
9039 (anything-c-gentoo-default-action elm "equery" "-C" "u")
9040 (font-lock-add-keywords nil '(("^\+.*" . font-lock-variable-name-face)))
9041 (font-lock-mode 1)))
9042 ("Run emerge pretend" . (lambda (elm)
9043 (anything-c-gentoo-eshell-action elm "emerge -p")))
9044 ("Emerge" . (lambda (elm)
9045 (anything-gentoo-install elm :action 'install)))
9046 ("Unmerge" . (lambda (elm)
9047 (anything-gentoo-install elm :action 'uninstall)))
9048 ("Show dependencies" . (lambda (elm)
9049 (anything-c-gentoo-default-action elm "equery" "-C" "d")))
9050 ("Show related files" . (lambda (elm)
9051 (anything-c-gentoo-default-action elm "equery" "files")))
9052 ("Refresh" . (lambda (elm)
9053 (anything-c-gentoo-setup-cache)
9054 (setq anything-c-cache-world (anything-c-gentoo-get-world))))))))
9056 ;; (anything 'anything-c-source-gentoo)
9058 (defun* anything-gentoo-install (candidate &key action)
9059 (setq anything-c-external-commands-list nil)
9060 (ansi-term (getenv "SHELL") "Gentoo emerge")
9061 (term-line-mode)
9062 (let ((command (case action
9063 ('install "sudo emerge -av ")
9064 ('uninstall "sudo emerge -avC ")
9065 (t (error "Unknow action"))))
9066 (elms (mapconcat 'identity (anything-marked-candidates) " "))
9067 (beg (point)) end)
9068 (goto-char (point-max))
9069 (insert (concat command elms))
9070 (setq end (point))
9071 (term-char-mode) (term-send-input)))
9073 (defun anything-c-gentoo-default-action (elm command &rest args)
9074 "Gentoo default action that use `anything-c-gentoo-buffer'."
9075 (if (member elm anything-c-cache-world)
9076 (progn
9077 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9078 (erase-buffer)
9079 (let ((com-list (append args (list elm))))
9080 (apply #'call-process command nil t nil
9081 com-list)))
9082 (message "No infos on packages not yet installed")))
9084 (defvar anything-c-source-use-flags
9085 '((name . "Use Flags")
9086 (init . (lambda ()
9087 (unless anything-c-gentoo-use-flags
9088 (anything-c-gentoo-setup-use-flags-cache))
9089 (anything-c-gentoo-get-use)))
9090 (candidates-in-buffer)
9091 (match . identity)
9092 (candidate-transformer anything-c-highlight-local-use)
9093 (action . (("Description"
9094 . (lambda (elm)
9095 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9096 (erase-buffer)
9097 (apply #'call-process "euse" nil t nil
9098 `("-i"
9099 ,elm))
9100 (font-lock-add-keywords nil `((,elm . font-lock-variable-name-face)))
9101 (font-lock-mode 1)))
9102 ("Enable"
9103 . (lambda (elm)
9104 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -E")))
9105 ("Disable"
9106 . (lambda (elm)
9107 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -D")))
9108 ("Remove"
9109 . (lambda (elm)
9110 (anything-c-gentoo-eshell-action elm "*sudo -p Password: euse -P")))
9111 ("Show which dep use this flag"
9112 . (lambda (elm)
9113 (anything-c-switch-to-buffer anything-c-gentoo-buffer)
9114 (erase-buffer)
9115 (apply #'call-process "equery" nil t nil
9116 `("-C"
9118 ,elm))))))))
9121 ;; (anything 'anything-c-source-use-flags)
9123 (defun anything-c-gentoo-init-list ()
9124 "Initialize buffer with all packages in Portage."
9125 (let* ((portage-buf (get-buffer-create "*anything-gentoo*"))
9126 (buf (anything-candidate-buffer 'portage-buf)))
9127 (with-current-buffer buf
9128 (dolist (i anything-c-cache-gentoo)
9129 (insert (concat i "\n"))))))
9131 (defun anything-c-gentoo-setup-cache ()
9132 "Set up `anything-c-cache-gentoo'"
9133 (setq anything-c-cache-gentoo
9134 (split-string (with-temp-buffer
9135 (call-process "eix" nil t nil
9136 "--only-names")
9137 (buffer-string)))))
9139 (defun anything-c-gentoo-eshell-action (elm command)
9140 (when (get-buffer "*EShell Command Output*")
9141 (kill-buffer "*EShell Command Output*"))
9142 (message "Wait searching...")
9143 (let ((buf-fname (buffer-file-name anything-current-buffer)))
9144 (if (and buf-fname (string-match tramp-file-name-regexp buf-fname))
9145 (progn
9146 (save-window-excursion
9147 (pop-to-buffer "*scratch*")
9148 (eshell-command (format "%s %s" command elm)))
9149 (pop-to-buffer "*EShell Command Output*"))
9150 (eshell-command (format "%s %s" command elm)))))
9152 (defun anything-c-gentoo-get-use ()
9153 "Initialize buffer with all use flags."
9154 (let* ((use-buf (get-buffer-create "*anything-gentoo-use*"))
9155 (buf (anything-candidate-buffer 'use-buf)))
9156 (with-current-buffer buf
9157 (dolist (i anything-c-gentoo-use-flags)
9158 (insert (concat i "\n"))))))
9161 (defun anything-c-gentoo-setup-use-flags-cache ()
9162 "Setup `anything-c-gentoo-use-flags'"
9163 (setq anything-c-gentoo-use-flags
9164 (split-string (with-temp-buffer
9165 (call-process "eix" nil t nil
9166 "--print-all-useflags")
9167 (buffer-string)))))
9169 (defun anything-c-gentoo-get-url (elm)
9170 "Return a list of urls from eix output."
9171 (loop
9172 with url-list = (split-string
9173 (with-temp-buffer
9174 (call-process "eix" nil t nil
9175 elm "--format" "<homepage>\n")
9176 (buffer-string)))
9177 with all
9178 for i in url-list
9179 when (and (string-match "^http://.*" i)
9180 (not (member i all)))
9181 collect i into all
9182 finally return all))
9184 (defun anything-c-gentoo-get-world ()
9185 "Return list of all installed package on your system."
9186 (split-string (with-temp-buffer
9187 (call-process "qlist" nil t nil
9188 "-I")
9189 (buffer-string))))
9191 (defun anything-c-gentoo-get-local-use ()
9192 (split-string (with-temp-buffer
9193 (call-process "portageq" nil t nil
9194 "envvar"
9195 "USE")
9196 (buffer-string))))
9199 (defun anything-c-highlight-world (eix)
9200 "Highlight all installed package."
9201 (loop for i in eix
9202 if (member i anything-c-cache-world)
9203 collect (propertize i 'face 'anything-gentoo-match-face)
9204 else
9205 collect i))
9207 (defun anything-c-highlight-local-use (use-flags)
9208 (let ((local-uses (anything-c-gentoo-get-local-use)))
9209 (loop for i in use-flags
9210 if (member i local-uses)
9211 collect (propertize i 'face 'anything-gentoo-match-face)
9212 else
9213 collect i)))
9215 (defvar anything-c-source-emacs-process
9216 '((name . "Emacs Process")
9217 (candidates . (lambda () (mapcar #'process-name (process-list))))
9218 (persistent-action . (lambda (elm)
9219 (delete-process (get-process elm))
9220 (anything-delete-current-selection)))
9221 (persistent-help . "Kill Process")
9222 (action ("Kill Process" . (lambda (elm)
9223 (delete-process (get-process elm)))))))
9225 ;; (anything 'anything-c-source-emacs-process)
9227 ;;; Anything `completing-read' replacement
9230 (defun anything-comp-read-get-candidates (collection &optional test sort-fn alistp)
9231 "Convert COLLECTION to list removing elements that don't match TEST.
9232 SORT-FN is a predicate to sort COLLECTION.
9233 ALISTP is a flag to not use `all-completions' which doesn't handle alists correctly\
9234 for anything.
9235 If collection is an `obarray', a TEST is needed. See `obarray'."
9236 (let ((cands
9237 (cond ((and (eq collection obarray) test)
9238 (all-completions "" collection test))
9239 ((and (vectorp collection) test)
9240 (loop for i across collection when (funcall test i) collect i))
9241 ((vectorp collection)
9242 (loop for i across collection collect i))
9243 ((and alistp test)
9244 (loop for i in collection when (funcall test i) collect i))
9245 (alistp collection)
9246 ((and collection test)
9247 (all-completions "" collection test))
9248 (t (all-completions "" collection)))))
9249 (if sort-fn (sort cands sort-fn) cands)))
9251 (defun anything-cr-default-transformer (candidates source)
9252 "Default filter candidate function for `anything-comp-read'.
9253 Do nothing, just return candidate list unmodified."
9254 candidates)
9256 (defun* anything-comp-read (prompt collection
9257 &key
9258 test
9259 initial-input
9260 (buffer "*Anything Completions*")
9261 must-match
9262 (requires-pattern 0)
9263 (history nil)
9264 (persistent-action nil)
9265 (persistent-help "DoNothing")
9266 (name "Anything Completions")
9267 (volatile t)
9268 sort
9269 (fc-transformer 'anything-cr-default-transformer)
9270 (marked-candidates nil)
9271 (alistp t))
9272 "Anything `completing-read' emulation.
9273 PROMPT is the prompt name to use.
9274 COLLECTION can be a list, vector, obarray or hash-table.
9275 Keys:
9277 TEST: A predicate called with one arg i.e candidate.
9278 INITIAL-INPUT: Same as initial-input arg in `anything'.
9279 BUFFER: Name of anything-buffer.
9280 MUST-MATCH: Candidate selected must be one of COLLECTION.
9281 REQUIRES-PATTERN: Same as anything attribute, default is 0.
9282 HISTORY: A list containing specific history, default is nil.
9283 When it is non--nil, all elements of HISTORY are displayed in
9284 anything-buffer before COLLECTION.
9285 PERSISTENT-ACTION: A function called with one arg i.e candidate.
9286 PERSISTENT-HELP: A string to document PERSISTENT-ACTION.
9287 NAME: The name related to this local source.
9288 VOLATILE: Use volatile attribute.
9289 SORT: A predicate to give to `sort' e.g `string-lessp'.
9290 FC-TRANSFORMER: A `filtered-candidate-transformer' function.
9291 MARKED-CANDIDATES: If non--nil return candidate or marked candidates as a list.
9292 ALISTP: when non--nil \(default\) cdr of alist is returned otherwise it is the car.
9294 Any prefix args passed during `anything-comp-read' invocation will be recorded
9295 in `anything-current-prefix-arg', otherwise if prefix args where given before
9296 `anything-comp-read' invocation, the value of `current-prefix-arg' will be used.
9297 That's mean you can pass prefix arg before or after calling
9298 a command that use `anything-comp-read'.
9299 It support now also a function as argument, See `all-completions' for more details."
9300 (when (get-buffer anything-action-buffer)
9301 (kill-buffer anything-action-buffer))
9302 (flet ((action-fn (candidate)
9303 (if marked-candidates
9304 (anything-marked-candidates)
9305 (identity candidate))))
9306 (let ((hist `((name . ,(format "%s History" name))
9307 (candidates . (lambda ()
9308 (anything-comp-read-get-candidates
9309 history nil nil ,alistp)))
9310 (persistent-action . ,persistent-action)
9311 (persistent-help . ,persistent-help)
9312 (action . ,'action-fn)))
9313 (src `((name . ,name)
9314 (candidates
9315 . (lambda ()
9316 (let ((cands (anything-comp-read-get-candidates
9317 collection test sort alistp)))
9318 (if (or must-match (string= anything-pattern ""))
9319 cands (append (list anything-pattern) cands)))))
9320 (filtered-candidate-transformer ,fc-transformer)
9321 (requires-pattern . ,requires-pattern)
9322 (persistent-action . ,persistent-action)
9323 (persistent-help . ,persistent-help)
9324 (action . ,'action-fn))))
9325 (when volatile (setq src (append src '((volatile)))))
9326 (or (anything
9327 :sources `(,hist ,src)
9328 :input initial-input
9329 :prompt prompt
9330 :resume 'noresume
9331 :buffer buffer)
9332 (keyboard-quit)))))
9334 ;; Generic completing-read
9336 ;; Support also function as collection.
9337 ;; e.g M-x man is supported.
9338 ;; Support hash-table and vectors as collection.
9339 ;; NOTE:
9340 ;; Some crap emacs functions may not be supported
9341 ;; like ffap-alternate-file (bad use of completing-read)
9342 ;; and maybe others.
9343 ;; Provide a mode `anything-completion-mode' which turn on
9344 ;; anything in all `completing-read' and `read-file-name' in Emacs.
9346 (defun anything-completing-read-default
9347 (prompt collection &optional
9348 predicate require-match
9349 initial-input hist def
9350 inherit-input-method)
9351 "An anything replacement of `completing-read'.
9353 Don't use it directly, use instead `anything-comp-read' in your programs \
9354 which is more powerful.
9356 See documentation of `completing-read' and `all-completions' for details."
9357 (let ((init (or def initial-input)))
9358 (anything-comp-read
9359 prompt collection
9360 :test predicate
9361 :fc-transformer #'(lambda (candidates source)
9362 (loop for i in candidates
9363 if (consp i) collect (car i)
9364 else collect i))
9365 :history (eval (or (car-safe hist) hist))
9366 :must-match require-match
9367 :alistp nil
9368 :initial-input init)))
9370 (defun anything-generic-read-file-name
9371 (prompt &optional dir default-filename mustmatch initial predicate)
9372 "An anything replacement of `read-file-name'."
9373 (let* ((default (and default-filename
9374 (if (listp default-filename)
9375 (car default-filename)
9376 default-filename)))
9377 (init (or default initial dir default-directory))
9378 (ini-input (and init (expand-file-name init))))
9379 (anything-c-read-file-name prompt
9380 :initial-input init
9381 :alistp nil
9382 :must-match mustmatch
9383 :test predicate)))
9385 (defvar anything-completion-mode-string " AC")
9386 ;;;###autoload
9387 (define-minor-mode anything-completion-mode
9388 "Toggle generic anything completion.
9389 All functions in Emacs that use `completing-read'
9390 or `read-file-name' and friends will use anything interface
9391 when this mode is turned on.
9392 Called with a positive arg, turn on inconditionnaly, with a
9393 negative arg turn off.
9394 You can turn it on with `ac-mode'.
9396 Some crap emacs functions may not be supported,
9397 e.g `ffap-alternate-file' and maybe others."
9398 :group 'anything
9399 :global t
9400 :lighter anything-completion-mode-string
9401 (if anything-completion-mode
9402 (progn
9403 (setq completing-read-function 'anything-completing-read-default
9404 read-file-name-function 'anything-generic-read-file-name)
9405 (message "Anything completion enabled"))
9406 (setq completing-read-function 'completing-read-default
9407 read-file-name-function 'read-file-name-default)
9408 (message "Anything completion disabled")))
9410 (defalias 'ac-mode 'anything-completion-mode)
9412 ;;; Eshell completion.
9414 ;; Enable like this in .emacs:
9416 ;; (add-hook 'eshell-mode-hook
9417 ;; #'(lambda ()
9418 ;; (define-key eshell-mode-map [remap pcomplete] 'anything-esh-pcomplete)))
9420 (defvar anything-c-source-esh
9421 '((name . "Eshell completions")
9422 (init . (lambda ()
9423 (setq pcomplete-current-completions nil
9424 pcomplete-last-completion-raw nil)))
9425 (candidates . anything-esh-get-candidates)
9426 (action . anything-ec-insert))
9427 "Anything source for Eshell completion.")
9429 ;; Internal.
9430 (defvar anything-ec-target "")
9431 (defun anything-ec-insert (candidate)
9432 "Insert CANDIDATE at point.
9433 This is the same as `ac-insert', just inlined here for compatibility."
9434 (let ((pt (point)))
9435 (when (and anything-ec-target
9436 (search-backward anything-ec-target nil t)
9437 (string= (buffer-substring (point) pt) anything-ec-target))
9438 (delete-region (point) pt)))
9439 (insert candidate))
9441 (defun anything-esh-get-candidates ()
9442 "Get candidates for eshell completion using `pcomplete'."
9443 (catch 'pcompleted
9444 (let* ((pcomplete-stub)
9445 pcomplete-seen pcomplete-norm-func
9446 pcomplete-args pcomplete-last pcomplete-index
9447 (pcomplete-autolist pcomplete-autolist)
9448 (pcomplete-suffix-list pcomplete-suffix-list))
9449 (with-current-buffer anything-current-buffer
9450 (loop
9451 with table = (pcomplete-completions)
9452 with entry = (condition-case nil
9453 ;; For Emacs24
9454 (funcall (pcomplete-entries) anything-pattern nil nil)
9455 ;; Fall back to this in Emacs23 as pcomplete-entries seem broken.
9456 (error
9458 (let ((fc (car (last (pcomplete-parse-arguments)))))
9459 ;; Check if last arg require fname completion.
9460 (and (file-name-directory fc) fc))))
9461 for i in (if (listp table) table ; Emacs23 or commands.
9462 (all-completions pcomplete-stub table)) ; Emacs24
9463 for file-cand = (and entry (expand-file-name i (file-name-directory entry)))
9464 if (and file-cand (file-exists-p file-cand)) collect file-cand into ls
9465 else collect i into ls
9466 finally return
9467 (if (and entry (not (string= entry "")) (file-exists-p entry))
9468 (append (list (expand-file-name entry default-directory)) ls) ls))))))
9470 ;;;###autoload
9471 (defun anything-esh-pcomplete ()
9472 "Preconfigured anything to provide anything completion in eshell."
9473 (interactive)
9474 (let* ((anything-quit-if-no-candidate t)
9475 (anything-execute-action-at-once-if-one t)
9476 (target (thing-at-point 'symbol))
9477 (end (point))
9478 (beg (or (and target (- end (length target)))
9479 ;; Nothing at point.
9480 (progn (insert " ") (point)))))
9481 (setq anything-ec-target (or target " "))
9482 (with-anything-show-completion beg end
9483 (anything :sources 'anything-c-source-esh
9484 :input (anything-ff-set-pattern ; Handle tramp filenames.
9485 (car (last (ignore-errors ; Needed in lisp symbols completion.
9486 (pcomplete-parse-arguments)))))))))
9488 ;;; Eshell history.
9491 (defvar anything-c-source-eshell-history
9492 '((name . "Eshell history")
9493 (init . (lambda ()
9494 (with-current-buffer (anything-candidate-buffer 'global)
9495 (insert-file-contents eshell-history-file-name))))
9496 (candidates-in-buffer)
9497 (action . (lambda (candidate)
9498 (insert candidate))))
9499 "Anything source for Eshell history.")
9501 ;;;###autoload
9502 (defun anything-eshell-history ()
9503 "Preconfigured anything for eshell history."
9504 (interactive)
9505 (let* ((end (point))
9506 (beg (progn (save-excursion (insert " ") (point)))))
9507 (with-anything-show-completion beg end
9508 (anything-other-buffer anything-c-source-eshell-history "*Eshell history*"))))
9510 ;;; Show completion - an alternative of anything-show-completion.el.
9512 ;; Provide show completion with macro `with-anything-show-completion'.
9515 ;; Internal
9516 (defvar anything-c-show-completion-overlay nil)
9518 ;; Called each time cursor move in anything-buffer.
9519 (defun anything-c-show-completion ()
9520 (overlay-put anything-c-show-completion-overlay
9521 'display (anything-get-selection)))
9523 (defun anything-c-show-completion-init-overlay (beg end)
9524 (and anything-c-turn-on-show-completion
9525 (setq anything-c-show-completion-overlay (make-overlay beg end))
9526 (overlay-put anything-c-show-completion-overlay
9527 'face 'anything-lisp-show-completion)))
9529 (defmacro with-anything-show-completion (beg end &rest body)
9530 "Show anything candidate in an overlay at point.
9531 BEG and END are the beginning and end position of the current completion
9532 in `anything-current-buffer'.
9533 BODY is an anything call where we want to enable show completion.
9534 If `anything-c-turn-on-show-completion' is nil just do nothing."
9535 (declare (indent 2) (debug t))
9536 `(let ((anything-move-selection-after-hook
9537 (and anything-c-turn-on-show-completion
9538 (append (list 'anything-c-show-completion)
9539 anything-move-selection-after-hook))))
9540 (unwind-protect
9541 (progn (anything-c-show-completion-init-overlay ,beg ,end)
9542 ,@body)
9543 (and anything-c-turn-on-show-completion
9544 (delete-overlay anything-c-show-completion-overlay)))))
9546 ;;; Lisp symbol completion.
9550 ;;;###autoload
9551 (defun anything-lisp-completion-at-point ()
9552 "Anything lisp symbol completion at point."
9553 (interactive)
9554 (let* ((data (lisp-completion-at-point))
9555 (beg (car data))
9556 (end (point)) ; 'cadr data' is wrong when no space after point.
9557 (plist (nthcdr 3 data))
9558 (pred (plist-get plist :predicate))
9559 (lgst-len 0)
9560 (target (and beg end (buffer-substring-no-properties beg end)))
9561 (candidates (all-completions target (nth 2 data) pred))
9562 (anything-quit-if-no-candidate t)
9563 (anything-execute-action-at-once-if-one t)
9564 (anything-match-plugin-enabled
9565 (member 'anything-compile-source--match-plugin
9566 anything-compile-source-functions)))
9567 (if candidates
9568 (with-anything-show-completion beg end
9569 ;; Overlay is initialized now in anything-current-buffer.
9570 (anything
9571 :sources
9572 '((name . "Lisp completion")
9573 (init . (lambda ()
9574 (with-current-buffer (anything-candidate-buffer 'global)
9575 (loop for sym in candidates
9576 for len = (length sym)
9577 when (> len lgst-len) do (setq lgst-len len)
9578 do (insert (concat sym "\n"))))))
9579 (candidates-in-buffer)
9580 (persistent-action . (lambda (candidate)
9581 (let ((cursor-in-echo-area t)
9582 mode-line-in-non-selected-windows)
9583 (anything-c-eldoc-show-in-mode-line
9584 (propertize
9585 (anything-c-get-first-line-documentation
9586 (intern candidate))
9587 'face 'anything-lisp-completion-info)))))
9588 (persistent-help . "Show brief doc in mode-line")
9589 (filtered-candidate-transformer anything-lisp-completion-transformer)
9590 (action . (lambda (candidate)
9591 (delete-region beg end)
9592 (insert candidate))))
9593 :input (if anything-match-plugin-enabled (concat target " ") target)))
9594 (message "[No Match]"))))
9596 (defun anything-lisp-completion-transformer (candidates source)
9597 "Anything candidates transformer for lisp completion."
9598 (declare (special lgst-len))
9599 (loop for c in candidates
9600 for sym = (intern c)
9601 for annot = (cond ((commandp sym) " (Com)")
9602 ((fboundp sym) " (Fun)")
9603 ((boundp sym) " (Var)")
9604 ((facep sym) " (Face)"))
9605 for spaces = (make-string (- lgst-len (length c)) ? )
9606 collect (cons (concat c spaces annot) c)))
9608 (defun anything-c-get-first-line-documentation (sym)
9609 "Return first line documentation of symbol SYM.
9610 If SYM is not documented, return \"Not documented\"."
9611 (let ((doc (cond ((fboundp sym)
9612 (documentation sym t))
9613 ((boundp sym)
9614 (documentation-property sym 'variable-documentation t))
9615 ((facep sym)
9616 (face-documentation sym))
9617 (t nil))))
9618 (if (and doc (not (string= doc ""))
9619 ;; `documentation' return "\n\n(args...)"
9620 ;; for CL-style functions.
9621 (not (string-match-p "^\n\n" doc)))
9622 (car (split-string doc "\n"))
9623 "Not documented")))
9625 ;;; File completion.
9627 ;; Complete file name at point.
9629 (defun anything-c-thing-before-point ()
9630 "Get symbol name before point.
9631 Borrowed from anything-complete.el, inlined here for compatibility."
9632 (save-excursion
9633 (let ((beg (point)))
9634 ;; older regexp "\(\\|\\s-\\|^\\|\\_<\\|\r\\|'\\|#'"
9635 (when (re-search-backward
9636 "\\_<" (field-beginning nil nil (point-at-bol)) t)
9637 (buffer-substring-no-properties beg (match-end 0))))))
9639 ;;;###autoload
9640 (defun anything-c-complete-file-name-at-point ()
9641 "Complete file name at point."
9642 (interactive)
9643 (let* ((init (substring-no-properties (thing-at-point 'filename)))
9644 (end (point))
9645 (beg (- (point) (length init)))
9646 (anything-quit-if-no-candidate t)
9647 (anything-execute-action-at-once-if-one t)
9648 completion)
9649 (with-anything-show-completion beg end
9650 (setq completion (anything-c-read-file-name "FileName: "
9651 :initial-input init
9652 :must-match t)))
9653 (anything-c-insert-file-name-completion-at-point completion)))
9655 ;; Internal
9656 (defvar anything-lisp-completion-counter 0)
9657 ;;;###autoload
9658 (defun anything-lisp-completion-at-point-or-indent (arg)
9659 "First call indent and second call complete lisp symbol.
9660 The second call should happen before `anything-lisp-completion-or-indent-delay',
9661 after this delay, next call will indent again.
9662 After completion, next call is always indent.
9663 See that like click and double mouse click.
9664 One hit indent, two quick hits maybe indent and complete."
9665 (interactive "P")
9666 ;; Be sure `indent-for-tab-command' will not try
9667 ;; to use `completion-at-point'.
9668 (let ((tab-always-indent (if (eq tab-always-indent 'complete)
9669 t tab-always-indent)))
9670 (incf anything-lisp-completion-counter)
9671 (unwind-protect
9672 (if (> anything-lisp-completion-counter 1)
9673 (anything-lisp-completion-or-file-name-at-point)
9674 (indent-for-tab-command arg))
9675 ;; After `anything-lisp-completion-or-indent-delay' seconds
9676 ;; reset to 0.
9677 (run-with-timer anything-lisp-completion-or-indent-delay nil
9678 #'(lambda ()
9679 (setq anything-lisp-completion-counter 0)))
9680 ;; Always reset to 0 at second hit.
9681 (when (eq anything-lisp-completion-counter 2)
9682 (setq anything-lisp-completion-counter 0)))))
9684 ;;;###autoload
9685 (defun anything-lisp-completion-or-file-name-at-point ()
9686 "Complete lisp symbol or filename at point.
9687 Filename completion happen if filename is started in
9688 or between double quotes."
9689 (interactive)
9690 (let ((tap (substring-no-properties (thing-at-point 'filename))))
9691 (if (and tap (string-match "^\\(~/\\|/\\|[a-zA-Z]\:/\\).*" tap)
9692 (save-excursion (search-backward "\"" (point-at-bol) t)))
9693 (anything-c-complete-file-name-at-point)
9694 (anything-lisp-completion-at-point))))
9696 ;;; Run Externals commands within Emacs with anything completion
9698 (defun anything-c-get-pid-from-process-name (process-name)
9699 "Get pid from running process PROCESS-NAME."
9700 (loop with process-list = (list-system-processes)
9701 for pid in process-list
9702 for process = (assoc-default 'comm (process-attributes pid))
9703 when (and process (string-match process-name process))
9704 return pid))
9707 (defun anything-run-or-raise (exe &optional file)
9708 "Generic command that run asynchronously EXE.
9709 If EXE is already running just jump to his window if `anything-raise-command'
9710 is non--nil.
9711 When FILE argument is provided run EXE with FILE.
9712 In this case EXE must be provided as \"EXE %s\"."
9713 (lexical-let* ((real-com (car (split-string (replace-regexp-in-string
9714 "'%s'" "" exe))))
9715 (proc (if file (concat real-com " " file) real-com)))
9716 (if (get-process proc)
9717 (if anything-raise-command
9718 (shell-command (format anything-raise-command real-com))
9719 (error "Error: %s is already running" real-com))
9720 (when (loop for i in anything-c-external-commands-list thereis real-com)
9721 (message "Starting %s..." real-com)
9722 (if file
9723 (start-process-shell-command proc nil (format exe file))
9724 (start-process-shell-command proc nil real-com))
9725 (set-process-sentinel
9726 (get-process proc)
9727 #'(lambda (process event)
9728 (when (and (string= event "finished\n")
9729 anything-raise-command
9730 (not (anything-c-get-pid-from-process-name real-com)))
9731 (shell-command (format anything-raise-command "emacs")))
9732 (message "%s process...Finished." process))))
9733 (setq anything-c-external-commands-list
9734 (cons real-com
9735 (delete real-com anything-c-external-commands-list))))))
9738 (defvar anything-external-command-history nil)
9739 ;;;###autoload
9740 (defun anything-c-run-external-command (program)
9741 "Preconfigured `anything' to run External PROGRAM asyncronously from Emacs.
9742 If program is already running exit with error.
9743 You can set your own list of commands with
9744 `anything-c-external-commands-list'."
9745 (interactive (list
9746 (anything-comp-read
9747 "RunProgram: "
9748 (anything-c-external-commands-list-1 'sort)
9749 :must-match t
9750 :name "External Commands"
9751 :history anything-external-command-history)))
9752 (anything-run-or-raise program)
9753 (setq anything-external-command-history
9754 (cons program (delete program
9755 (loop for i in anything-external-command-history
9756 when (executable-find i) collect i)))))
9758 (defsubst* anything-c-position (item seq &key (test 'eq))
9759 "A simple and faster replacement of CL `position'."
9760 (loop for i in seq for index from 0
9761 when (funcall test i item) return index))
9763 (defvar anything-c-source-ratpoison-commands
9764 '((name . "Ratpoison Commands")
9765 (init . anything-c-ratpoison-commands-init)
9766 (candidates-in-buffer)
9767 (action ("Execute the command" . anything-c-ratpoison-commands-execute))
9768 (display-to-real . anything-c-ratpoison-commands-display-to-real)
9769 (candidate-number-limit)))
9770 ;; (anything 'anything-c-source-ratpoison-commands)
9772 (defun anything-c-ratpoison-commands-init ()
9773 (unless (anything-candidate-buffer)
9774 (with-current-buffer (anything-candidate-buffer 'global)
9775 ;; with ratpoison prefix key
9776 (save-excursion
9777 (call-process "ratpoison" nil (current-buffer) nil "-c" "help"))
9778 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9779 (replace-match "<ratpoison> \\1: \\2"))
9780 (goto-char (point-max))
9781 ;; direct binding
9782 (save-excursion
9783 (call-process "ratpoison" nil (current-buffer) nil "-c" "help top"))
9784 (while (re-search-forward "^\\([^ ]+\\) \\(.+\\)$" nil t)
9785 (replace-match "\\1: \\2")))))
9787 (defun anything-c-ratpoison-commands-display-to-real (display)
9788 (and (string-match ": " display)
9789 (substring display (match-end 0))))
9791 (defun anything-c-ratpoison-commands-execute (candidate)
9792 (call-process "ratpoison" nil nil nil "-ic" candidate))
9794 ;;;###autoload
9795 (defun anything-ratpoison-commands ()
9796 "Preconfigured `anything' to execute ratpoison commands."
9797 (interactive)
9798 (anything-other-buffer 'anything-c-source-ratpoison-commands
9799 "*anything ratpoison commands*"))
9801 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9802 ;;; Files
9804 (defun anything-c-external-commands-list-1 (&optional sort)
9805 "Returns a list of all external commands the user can execute.
9806 If `anything-c-external-commands-list' is non-nil it will
9807 return its contents. Else it calculates all external commands
9808 and sets `anything-c-external-commands-list'."
9809 (if anything-c-external-commands-list
9810 anything-c-external-commands-list
9811 (setq anything-c-external-commands-list
9812 (loop
9813 with paths = (split-string (getenv "PATH") path-separator)
9814 with completions = ()
9815 for dir in paths
9816 when (and (file-exists-p dir) (file-accessible-directory-p dir))
9817 for lsdir = (loop for i in (directory-files dir t)
9818 for bn = (file-name-nondirectory i)
9819 when (and (not (member bn completions))
9820 (not (file-directory-p i))
9821 (file-executable-p i))
9822 collect bn)
9823 append lsdir into completions
9824 finally return (if sort (sort completions 'string-lessp) completions)))))
9827 (defun anything-c-file-buffers (filename)
9828 "Returns a list of buffer names corresponding to FILENAME."
9829 (let ((name (expand-file-name filename))
9830 (buf-list ()))
9831 (dolist (buf (buffer-list) buf-list)
9832 (let ((bfn (buffer-file-name buf)))
9833 (when (and bfn (string= name bfn))
9834 (push (buffer-name buf) buf-list))))))
9837 (defun anything-c-delete-file (file)
9838 "Delete the given file after querying the user.
9839 Ask to kill buffers associated with that file, too."
9840 (let ((buffers (anything-c-file-buffers file)))
9841 (if (< emacs-major-version 24)
9842 ;; `dired-delete-file' in Emacs versions < 24
9843 ;; doesn't support delete-by-moving-to-trash
9844 ;; so use `delete-directory' and `delete-file'
9845 ;; that handle it.
9846 (cond ((and (not (file-symlink-p file))
9847 (file-directory-p file)
9848 (directory-files file t dired-re-no-dot))
9849 (when (y-or-n-p (format "Recursive delete of `%s'? " file))
9850 (delete-directory file 'recursive)))
9851 ((and (not (file-symlink-p file))
9852 (file-directory-p file))
9853 (delete-directory file))
9854 (t (delete-file file)))
9855 (dired-delete-file
9856 file 'dired-recursive-deletes delete-by-moving-to-trash))
9857 (when buffers
9858 (dolist (buf buffers)
9859 (when (y-or-n-p (format "Kill buffer %s, too? " buf))
9860 (kill-buffer buf))))))
9862 (defun anything-get-mailcap-for-file (filename)
9863 "Get the command to use for FILENAME from mailcap files.
9864 The command is like <command %s> and is meant to use with `format'."
9865 (mailcap-parse-mailcaps)
9866 (let* ((ext (file-name-extension filename))
9867 (mime (when ext (mailcap-extension-to-mime ext)))
9868 (result (when mime (mailcap-mime-info mime))))
9869 ;; If elisp file have no associations in .mailcap
9870 ;; `mailcap-maybe-eval' is returned, in this case just return nil.
9871 (when (stringp result) result)))
9873 (defun anything-get-default-program-for-file (filename)
9874 "Try to find a default program to open FILENAME.
9875 Try first in `anything-c-external-programs-associations' and then in mailcap file
9876 if nothing found return nil."
9877 (let* ((ext (file-name-extension filename))
9878 (def-prog (assoc-default ext anything-c-external-programs-associations)))
9879 (cond ((and def-prog (not (string= def-prog "")))
9880 (concat def-prog " %s"))
9881 ((and anything-c-default-external-file-browser
9882 (file-directory-p filename))
9883 (concat anything-c-default-external-file-browser " %s"))
9884 (t (anything-get-mailcap-for-file filename)))))
9886 (defun anything-c-open-file-externally (file)
9887 "Open FILE with an external program.
9888 Try to guess which program to use with `anything-get-default-program-for-file'.
9889 If not found or a prefix arg is given query the user which tool to use."
9890 (let* ((fname (expand-file-name file))
9891 (collection (anything-c-external-commands-list-1 'sort))
9892 (def-prog (anything-get-default-program-for-file fname))
9893 (real-prog-name (if (or anything-current-prefix-arg (not def-prog))
9894 ;; Prefix arg or no default program.
9895 (prog1
9896 (anything-comp-read
9897 "Program: " collection
9898 :must-match t
9899 :name "Open file Externally"
9900 :history anything-external-command-history)
9901 ;; Always prompt to set this program as default.
9902 (setq def-prog nil))
9903 ;; No prefix arg or default program exists.
9904 (replace-regexp-in-string " %s\\| '%s'" "" def-prog)))
9905 (program (concat real-prog-name " '%s'")))
9906 (unless (or def-prog ; Association exists, no need to record it.
9907 ;; Don't try to record non--filenames associations (e.g urls).
9908 (not (file-exists-p fname)))
9909 (when
9910 (y-or-n-p
9911 (format
9912 "Do you want to make `%s' the default program for this kind of files? "
9913 real-prog-name))
9914 (anything-aif (assoc (file-name-extension fname)
9915 anything-c-external-programs-associations)
9916 (setq anything-c-external-programs-associations
9917 (delete it anything-c-external-programs-associations)))
9918 (push (cons (file-name-extension fname)
9919 (read-string
9920 "Program (Add args maybe and confirm): " real-prog-name))
9921 anything-c-external-programs-associations)
9922 (customize-save-variable 'anything-c-external-programs-associations
9923 anything-c-external-programs-associations)))
9924 (anything-run-or-raise program file)
9925 (setq anything-external-command-history
9926 (cons real-prog-name
9927 (delete real-prog-name
9928 (loop for i in anything-external-command-history
9929 when (executable-find i) collect i))))))
9932 ;;;###autoload
9933 (defun w32-shell-execute-open-file (file)
9934 (interactive "fOpen file:")
9935 (with-no-warnings
9936 (w32-shell-execute "open" (replace-regexp-in-string ;for UNC paths
9937 "/" "\\"
9938 (replace-regexp-in-string ; strip cygdrive paths
9939 "/cygdrive/\\(.\\)" "\\1:"
9940 file nil nil) nil t))))
9942 (defun anything-c-open-file-with-default-tool (file)
9943 "Open FILE with the default tool on this platform."
9944 (if (eq system-type 'windows-nt)
9945 (w32-shell-execute-open-file file)
9946 (start-process "anything-c-open-file-with-default-tool"
9948 (cond ((eq system-type 'gnu/linux)
9949 "xdg-open")
9950 ((or (eq system-type 'darwin) ;; Mac OS X
9951 (eq system-type 'macos)) ;; Mac OS 9
9952 "open"))
9953 file)))
9955 (defun anything-c-open-dired (file)
9956 "Opens a dired buffer in FILE's directory. If FILE is a
9957 directory, open this directory."
9958 (if (file-directory-p file)
9959 (dired file)
9960 (dired (file-name-directory file))
9961 (dired-goto-file file)))
9963 (defun anything-c-display-to-real-line (candidate)
9964 (if (string-match "^ *\\([0-9]+\\):\\(.*\\)$" candidate)
9965 (list (string-to-number (match-string 1 candidate)) (match-string 2 candidate))
9966 (error "Line number not found")))
9968 (defun anything-c-action-line-goto (lineno-and-content)
9969 (apply #'anything-goto-file-line (anything-interpret-value (anything-attr 'target-file))
9970 (append lineno-and-content
9971 (list (if (and (anything-attr-defined 'target-file)
9972 (not anything-in-persistent-action))
9973 'find-file-other-window
9974 'find-file)))))
9976 (defun* anything-c-action-file-line-goto (file-line-content &optional (find-file-function #'find-file))
9977 (apply #'anything-goto-file-line
9978 (if (stringp file-line-content)
9979 ;; Case: filtered-candidate-transformer is skipped
9980 (cdr (anything-c-filtered-candidate-transformer-file-line-1 file-line-content))
9981 file-line-content)))
9983 (require 'compile)
9984 (defun anything-c-filtered-candidate-transformer-file-line (candidates source)
9985 (delq nil (mapcar 'anything-c-filtered-candidate-transformer-file-line-1 candidates)))
9987 (defun anything-c-filtered-candidate-transformer-file-line-1 (candidate)
9988 (when (string-match "^\\(.+?\\):\\([0-9]+\\):\\(.*\\)$" candidate)
9989 (let ((filename (match-string 1 candidate))
9990 (lineno (match-string 2 candidate))
9991 (content (match-string 3 candidate)))
9992 (cons (format "%s:%s\n %s"
9993 (propertize filename 'face compilation-info-face)
9994 (propertize lineno 'face compilation-line-face)
9995 content)
9996 (list (expand-file-name
9997 filename
9998 (or (anything-interpret-value (anything-attr 'default-directory))
9999 (and (anything-candidate-buffer)
10000 (buffer-local-value
10001 'default-directory (anything-candidate-buffer)))))
10002 (string-to-number lineno) content)))))
10004 (defun* anything-goto-file-line (file lineno content &optional (find-file-function #'find-file))
10005 (anything-aif (anything-attr 'before-jump-hook)
10006 (funcall it))
10007 (when file (funcall find-file-function file))
10008 (if (anything-attr-defined 'adjust)
10009 (anything-c-goto-line-with-adjustment lineno content)
10010 (anything-goto-line lineno))
10011 (unless (anything-attr-defined 'recenter)
10012 (set-window-start (get-buffer-window anything-current-buffer) (point)))
10013 (anything-aif (anything-attr 'after-jump-hook)
10014 (funcall it))
10015 (when anything-in-persistent-action
10016 (anything-match-line-color-current-line)))
10018 (defun anything-find-file-as-root (candidate)
10019 (find-file (concat "/" anything-su-or-sudo "::" (expand-file-name candidate))))
10021 (defun anything-find-many-files (ignore)
10022 (mapc 'find-file (anything-marked-candidates)))
10024 ;; borrowed from etags.el
10025 ;; (anything-c-goto-line-with-adjustment (line-number-at-pos) ";; borrowed from etags.el")
10026 (defun anything-c-goto-line-with-adjustment (line line-content)
10027 (let ((startpos)
10028 offset found pat)
10029 ;; This constant is 1/2 the initial search window.
10030 ;; There is no sense in making it too small,
10031 ;; since just going around the loop once probably
10032 ;; costs about as much as searching 2000 chars.
10033 (setq offset 1000
10034 found nil
10035 pat (concat (if (eq selective-display t)
10036 "\\(^\\|\^m\\) *" "^ *") ;allow indent
10037 (regexp-quote line-content)))
10038 ;; If no char pos was given, try the given line number.
10039 (setq startpos (progn (anything-goto-line line) (point)))
10040 (or startpos (setq startpos (point-min)))
10041 ;; First see if the tag is right at the specified location.
10042 (goto-char startpos)
10043 (setq found (looking-at pat))
10044 (while (and (not found)
10045 (progn
10046 (goto-char (- startpos offset))
10047 (not (bobp))))
10048 (setq found
10049 (re-search-forward pat (+ startpos offset) t)
10050 offset (* 3 offset))) ; expand search window
10051 (or found
10052 (re-search-forward pat nil t)
10053 (error "not found")))
10054 ;; Position point at the right place
10055 ;; if the search string matched an extra Ctrl-m at the beginning.
10056 (and (eq selective-display t)
10057 (looking-at "\^m")
10058 (forward-char 1))
10059 (beginning-of-line))
10061 (anything-document-attribute 'default-directory "type . file-line"
10062 "`default-directory' to interpret file.")
10063 (anything-document-attribute 'before-jump-hook "type . file-line / line"
10064 "Function to call before jumping to the target location.")
10065 (anything-document-attribute 'after-jump-hook "type . file-line / line"
10066 "Function to call after jumping to the target location.")
10067 (anything-document-attribute 'adjust "type . file-line"
10068 "Search around line matching line contents.")
10069 (anything-document-attribute 'recenter "type . file-line / line"
10070 "`recenter' after jumping.")
10071 (anything-document-attribute 'target-file "type . line"
10072 "Goto line of target-file.")
10074 ;;;###autoload
10075 (defun anything-c-call-interactively (cmd-or-name)
10076 "Execute CMD-OR-NAME as Emacs command.
10077 It is added to `extended-command-history'.
10078 `anything-current-prefix-arg' is used as the command's prefix argument."
10079 (setq extended-command-history
10080 (cons (anything-c-stringify cmd-or-name)
10081 (delete (anything-c-stringify cmd-or-name) extended-command-history)))
10082 (let ((current-prefix-arg anything-current-prefix-arg)
10083 (cmd (anything-c-symbolify cmd-or-name)))
10084 (if (stringp (symbol-function cmd))
10085 (execute-kbd-macro (symbol-function cmd))
10086 (setq this-command cmd)
10087 (call-interactively cmd))))
10089 ;;;###autoload
10090 (defun anything-c-set-variable (var)
10091 "Set value to VAR interactively."
10092 (interactive)
10093 (let ((sym (anything-c-symbolify var)))
10094 (set sym (eval-minibuffer (format "Set %s: " var)
10095 (prin1-to-string (symbol-value sym))))))
10096 ;; (setq hh 12)
10097 ;; (anything-c-set-variable 'hh)
10099 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Persistent Action Helpers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10100 (defvar anything-match-line-overlay-face nil)
10101 (defvar anything-match-line-overlay nil)
10103 (defun anything-match-line-color-current-line (&optional start end buf face rec)
10104 "Highlight and underline current position"
10105 (let ((args (list (or start (line-beginning-position))
10106 (or end (1+ (line-end-position)))
10107 buf)))
10108 (if (not anything-match-line-overlay)
10109 (setq anything-match-line-overlay (apply 'make-overlay args))
10110 (apply 'move-overlay anything-match-line-overlay args)))
10111 (overlay-put anything-match-line-overlay
10112 'face (or face anything-match-line-overlay-face))
10113 (when rec
10114 (goto-char start)
10115 (recenter)))
10117 (defalias 'anything-persistent-highlight-point 'anything-match-line-color-current-line)
10120 (setq anything-match-line-overlay-face 'anything-overlay-line-face)
10122 (defun anything-match-line-cleanup ()
10123 (when anything-match-line-overlay
10124 (delete-overlay anything-match-line-overlay)
10125 (setq anything-match-line-overlay nil)))
10127 (defun anything-match-line-update ()
10128 (when anything-match-line-overlay
10129 (delete-overlay anything-match-line-overlay)
10130 (anything-match-line-color-current-line)))
10132 (add-hook 'anything-cleanup-hook 'anything-match-line-cleanup)
10133 (add-hook 'anything-after-persistent-action-hook 'anything-match-line-update)
10135 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Actions Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10136 ;;; Files
10137 (defun anything-c-transform-file-load-el (actions candidate)
10138 "Add action to load the file CANDIDATE if it is an emacs lisp
10139 file. Else return ACTIONS unmodified."
10140 (if (member (file-name-extension candidate) '("el" "elc"))
10141 (append actions '(("Load Emacs Lisp File" . load-file)))
10142 actions))
10144 (defun anything-c-transform-file-browse-url (actions candidate)
10145 "Add an action to browse the file CANDIDATE if it in a html
10146 file or URL. Else return ACTIONS unmodified."
10147 (let ((browse-action '("Browse with Browser" . browse-url)))
10148 (cond ((string-match "^http\\|^ftp" candidate)
10149 (cons browse-action actions))
10150 ((string-match "\\.html?$" candidate)
10151 (append actions (list browse-action)))
10152 (t actions))))
10154 ;;;; Function
10155 (defun anything-c-transform-function-call-interactively (actions candidate)
10156 "Add an action to call the function CANDIDATE interactively if
10157 it is a command. Else return ACTIONS unmodified."
10158 (if (commandp (intern-soft candidate))
10159 (append actions '(("Call Interactively"
10161 anything-c-call-interactively)))
10162 actions))
10164 ;;;; S-Expressions
10165 (defun anything-c-transform-sexp-eval-command-sexp (actions candidate)
10166 "If CANDIDATE's `car' is a command, then add an action to
10167 evaluate it and put it onto the `command-history'."
10168 (if (commandp (car (read candidate)))
10169 ;; Make it first entry
10170 (cons '("Eval and put onto command-history" .
10171 (lambda (sexp)
10172 (let ((sym (read sexp)))
10173 (eval sym)
10174 (setq command-history
10175 (cons sym command-history)))))
10176 actions)
10177 actions))
10179 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Candidate Transformers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10180 ;;; Buffers
10181 (defun anything-c-skip-boring-buffers (buffers)
10182 (anything-c-skip-entries buffers anything-c-boring-buffer-regexp))
10184 (defun anything-c-skip-current-buffer (buffers)
10185 (if anything-allow-skipping-current-buffer
10186 (remove (buffer-name anything-current-buffer) buffers)
10187 buffers))
10189 (defun anything-c-shadow-boring-buffers (buffers)
10190 "Buffers matching `anything-c-boring-buffer-regexp' will be
10191 displayed with the `file-name-shadow' face if available."
10192 (anything-c-shadow-entries buffers anything-c-boring-buffer-regexp))
10194 (defvar anything-c-buffer-display-string-functions
10195 '(anything-c-buffer-display-string--compilation
10196 anything-c-buffer-display-string--shell
10197 anything-c-buffer-display-string--eshell)
10198 "Functions to setup display string for buffer.
10200 Function has one argument, buffer name.
10201 If it returns string, use it.
10202 If it returns nil, display buffer name.
10203 See `anything-c-buffer-display-string--compilation' for example.")
10205 (defun anything-c-transform-buffer-display-string (buffers)
10206 "Setup display string for buffer candidates
10207 using `anything-c-buffer-display-string-functions'."
10208 (loop for buf in buffers
10209 if (consp buf)
10210 collect buf
10211 else
10212 for disp = (progn (set-buffer buf)
10213 (run-hook-with-args-until-success
10214 'anything-c-buffer-display-string-functions buf))
10215 collect (if disp (cons disp buf) buf)))
10217 (defun anything-c-buffer-display-string--compilation (buf)
10218 (anything-aif (car compilation-arguments)
10219 (format "%s: %s [%s]" buf it default-directory)))
10221 (defun anything-c-buffer-display-string--eshell (buf)
10222 (declare (special eshell-history-ring))
10223 (when (eq major-mode 'eshell-mode)
10224 (format "%s: %s [%s]" buf
10225 (ignore-errors (ring-ref eshell-history-ring 0))
10226 default-directory)))
10228 (defun anything-c-buffer-display-string--shell (buf)
10229 (when (eq major-mode 'shell-mode)
10230 (format "%s: %s [%s]" buf
10231 (ignore-errors (ring-ref comint-input-ring 0))
10232 default-directory)))
10234 ;;; Files
10235 (defun anything-c-shadow-boring-files (files)
10236 "Files matching `anything-c-boring-file-regexp' will be
10237 displayed with the `file-name-shadow' face if available."
10238 (anything-c-shadow-entries files anything-c-boring-file-regexp))
10240 (defun anything-c-skip-boring-files (files)
10241 "Files matching `anything-c-boring-file-regexp' will be skipped."
10242 (anything-c-skip-entries files anything-c-boring-file-regexp))
10243 ;; (anything-c-skip-boring-files '("README" "/src/.svn/hoge"))
10245 (defun anything-c-skip-current-file (files)
10246 "Current file will be skipped."
10247 (remove (buffer-file-name anything-current-buffer) files))
10249 (defun anything-c-w32-pathname-transformer (args)
10250 "Change undesirable features of windows pathnames to ones more acceptable to
10251 other candidate transformers."
10252 (if (eq system-type 'windows-nt)
10253 (mapcar (lambda (x)
10254 (replace-regexp-in-string "/cygdrive/\\(.\\)" "\\1:" x))
10255 (mapcar (lambda (y)
10256 (replace-regexp-in-string "\\\\" "/" y)) args))
10257 args))
10259 (defun anything-c-shorten-home-path (files)
10260 "Replaces /home/user with ~."
10261 (let ((home (replace-regexp-in-string "\\\\" "/" ; stupid Windows...
10262 (getenv "HOME"))))
10263 (mapcar (lambda (file)
10264 (if (and (stringp file) (string-match home file))
10265 (cons (replace-match "~" nil nil file) file)
10266 file))
10267 files)))
10269 ;;; Functions
10270 (defun anything-c-mark-interactive-functions (functions)
10271 "Mark interactive functions (commands) with (i) after the function name."
10272 (let (list)
10273 (loop for function in functions
10274 do (push (cons (concat function
10275 (when (commandp (intern-soft function)) " (i)"))
10276 function)
10277 list)
10278 finally (return (nreverse list)))))
10280 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Adaptive Sorting of Candidates ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10282 ;; Internal
10283 (defvar anything-c-adaptive-done nil
10284 "nil if history information is not yet stored for the current
10285 selection.")
10287 (defvar anything-c-adaptive-history nil
10288 "Contains the stored history information.
10289 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
10291 (defadvice anything-initialize (before anything-c-adaptive-initialize activate)
10292 "Advise `anything-initialize' to reset `anything-c-adaptive-done'
10293 when anything is started."
10294 (when anything-c-use-adaptative-sorting
10295 (setq anything-c-adaptive-done nil)))
10297 (defadvice anything-exit-minibuffer (before anything-c-adaptive-exit-minibuffer activate)
10298 "Advise `anything-exit-minibuffer' to store history information
10299 when a candidate is selected with RET."
10300 (when anything-c-use-adaptative-sorting
10301 (anything-c-adaptive-store-selection)))
10303 (defadvice anything-select-action (before anything-c-adaptive-select-action activate)
10304 "Advise `anything-select-action' to store history information
10305 when the user goes to the action list with TAB."
10306 (when anything-c-use-adaptative-sorting
10307 (anything-c-adaptive-store-selection)))
10309 (defun anything-c-source-use-adaptative-p (&optional source-name)
10310 "Return current source only if it use adaptative history, nil otherwise."
10311 (when anything-c-use-adaptative-sorting
10312 (let* ((source (or source-name (anything-get-current-source)))
10313 (adapt-source (or (assoc-default 'filtered-candidate-transformer
10314 (assoc (assoc-default 'type source)
10315 anything-type-attributes))
10316 (assoc-default 'candidate-transformer
10317 (assoc (assoc-default 'type source)
10318 anything-type-attributes))
10319 (assoc-default 'filtered-candidate-transformer source)
10320 (assoc-default 'candidate-transformer source))))
10321 (if (listp adapt-source)
10322 (when (member 'anything-c-adaptive-sort adapt-source) source)
10323 (when (eq adapt-source 'anything-c-adaptive-sort) source)))))
10325 (defun anything-c-adaptive-store-selection ()
10326 "Store history information for the selected candidate."
10327 (unless anything-c-adaptive-done
10328 (setq anything-c-adaptive-done t)
10329 (let ((source (anything-c-source-use-adaptative-p)))
10330 (when source
10331 (let* ((source-name (or (assoc-default 'type source)
10332 (assoc-default 'name source)))
10333 (source-info (or (assoc source-name anything-c-adaptive-history)
10334 (progn
10335 (push (list source-name) anything-c-adaptive-history)
10336 (car anything-c-adaptive-history))))
10337 (selection (anything-get-selection))
10338 (selection-info (progn
10339 (setcdr source-info
10340 (cons
10341 (let ((found (assoc selection (cdr source-info))))
10342 (if (not found)
10343 ;; new entry
10344 (list selection)
10346 ;; move entry to the beginning of the
10347 ;; list, so that it doesn't get
10348 ;; trimmed when the history is
10349 ;; truncated
10350 (setcdr source-info
10351 (delete found (cdr source-info)))
10352 found))
10353 (cdr source-info)))
10354 (cadr source-info)))
10355 (pattern-info (progn
10356 (setcdr selection-info
10357 (cons
10358 (let ((found (assoc anything-pattern (cdr selection-info))))
10359 (if (not found)
10360 ;; new entry
10361 (cons anything-pattern 0)
10363 ;; move entry to the beginning of the
10364 ;; list, so if two patterns used the
10365 ;; same number of times then the one
10366 ;; used last appears first in the list
10367 (setcdr selection-info
10368 (delete found (cdr selection-info)))
10369 found))
10370 (cdr selection-info)))
10371 (cadr selection-info))))
10373 ;; increase usage count
10374 (setcdr pattern-info (1+ (cdr pattern-info)))
10376 ;; truncate history if needed
10377 (if (> (length (cdr selection-info)) anything-c-adaptive-history-length)
10378 (setcdr selection-info
10379 (subseq (cdr selection-info) 0 anything-c-adaptive-history-length))))))))
10381 (defun anything-c-adaptative-maybe-load-history ()
10382 (when (and anything-c-use-adaptative-sorting
10383 (file-readable-p anything-c-adaptive-history-file))
10384 (load-file anything-c-adaptive-history-file)))
10386 (add-hook 'emacs-startup-hook 'anything-c-adaptative-maybe-load-history)
10387 (add-hook 'kill-emacs-hook 'anything-c-adaptive-save-history)
10389 (defun anything-c-adaptive-save-history (&optional arg)
10390 "Save history information to file given by `anything-c-adaptive-history-file'."
10391 (interactive "p")
10392 (when anything-c-use-adaptative-sorting
10393 (with-temp-buffer
10394 (insert
10395 ";; -*- mode: emacs-lisp -*-\n"
10396 ";; History entries used for anything adaptive display.\n")
10397 (prin1 `(setq anything-c-adaptive-history ',anything-c-adaptive-history)
10398 (current-buffer))
10399 (insert ?\n)
10400 (write-region (point-min) (point-max) anything-c-adaptive-history-file nil
10401 (unless arg 'quiet)))))
10403 (defun anything-c-adaptive-sort (candidates source)
10404 "Sort the CANDIDATES for SOURCE by usage frequency.
10405 This is a filtered candidate transformer you can use for the
10406 attribute `filtered-candidate-transformer' of a source in
10407 `anything-sources' or a type in `anything-type-attributes'."
10408 (let* ((source-name (or (assoc-default 'type source)
10409 (assoc-default 'name source)))
10410 (source-info (assoc source-name anything-c-adaptive-history)))
10411 (if source-info
10412 (let ((usage
10413 ;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
10414 ;; pairs
10415 (mapcar (lambda (candidate-info)
10416 (let ((count 0))
10417 (dolist (pattern-info (cdr candidate-info))
10418 (if (not (equal (car pattern-info)
10419 anything-pattern))
10420 (incf count (cdr pattern-info))
10422 ;; if current pattern is equal to the previously
10423 ;; used one then this candidate has priority
10424 ;; (that's why its count is boosted by 10000) and
10425 ;; it only has to compete with other candidates
10426 ;; which were also selected with the same pattern
10427 (setq count (+ 10000 (cdr pattern-info)))
10428 (return)))
10429 (cons (car candidate-info) count)))
10430 (cdr source-info)))
10431 sorted)
10432 (if (and usage (consp usage))
10433 ;; sort the list in descending order, so candidates with highest
10434 ;; priorty come first
10435 (progn
10436 (setq usage (sort usage (lambda (first second)
10437 (> (cdr first) (cdr second)))))
10439 ;; put those candidates first which have the highest usage count
10440 (dolist (info usage)
10441 (when (member* (car info) candidates
10442 :test 'anything-c-adaptive-compare)
10443 (push (car info) sorted)
10444 (setq candidates (remove* (car info) candidates
10445 :test 'anything-c-adaptive-compare))))
10447 ;; and append the rest
10448 (append (reverse sorted) candidates nil))
10449 (message "Your `%s' is maybe corrupted or too old, \
10450 you should reinitialize it with `anything-c-reset-adaptative-history'"
10451 anything-c-adaptive-history-file)
10452 (sit-for 1)
10453 candidates))
10454 ;; if there is no information stored for this source then do nothing
10455 candidates)))
10457 ;;;###autoload
10458 (defun anything-c-reset-adaptative-history ()
10459 "Delete all `anything-c-adaptive-history' and his file.
10460 Useful when you have a old or corrupted `anything-c-adaptive-history-file'."
10461 (interactive)
10462 (when (y-or-n-p "Really delete all your `anything-c-adaptive-history'? ")
10463 (setq anything-c-adaptive-history nil)
10464 (delete-file anything-c-adaptive-history-file)))
10466 (defun anything-c-adaptive-compare (x y)
10467 "Compare candidates X and Y taking into account that the
10468 candidate can be in (DISPLAY . REAL) format."
10469 (equal (if (listp x)
10470 (cdr x)
10472 (if (listp y)
10473 (cdr y)
10474 y)))
10476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Outliner ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10477 (defvar anything-outline-goto-near-line-flag t)
10478 (defvar anything-outline-using nil)
10479 (defun anything-after-update-hook--outline ()
10480 (if (and (eq anything-outline-using t)
10481 (eq anything-outline-goto-near-line-flag t))
10482 (anything-outline-goto-near-line)))
10483 (add-hook 'anything-after-update-hook 'anything-after-update-hook--outline)
10485 (defun anything-outline-goto-near-line ()
10486 (with-anything-window
10487 ;; TODO need consideration whether to update position by every input.
10488 (when t ; (equal anything-pattern "")
10489 (anything-goto-line 2)
10490 (let ((lineno (with-current-buffer anything-current-buffer
10491 (line-number-at-pos (car anything-current-position)))))
10492 (block exit
10493 (while (<= (progn (skip-chars-forward " ")
10494 (or (number-at-point) lineno))
10495 lineno)
10496 (forward-line 1)
10497 (when (eobp)
10498 (forward-line -1)
10499 (return-from exit))))
10500 (forward-line -1)
10501 (and (bobp) (forward-line 1))
10502 (and (anything-pos-header-line-p) (forward-line -2))
10503 (anything-mark-current-line)))))
10505 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Plug-in ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10506 ;; Plug-in: info-index
10507 (defun* anything-c-info-init (&optional (file (anything-attr 'info-file)))
10508 (let (result)
10509 (unless (anything-candidate-buffer)
10510 (save-window-excursion
10511 (info file)
10512 (let (Info-history
10513 (tobuf (anything-candidate-buffer 'global))
10514 (infobuf (current-buffer))
10515 s e)
10516 (dolist (node (or (anything-attr 'index-nodes) (Info-index-nodes)))
10517 (Info-goto-node node)
10518 (goto-char (point-min))
10519 (while (search-forward "\n* " nil t)
10520 (unless (search-forward "Menu:\n" (1+ (point-at-eol)) t)
10521 '(save-current-buffer (buffer-substring-no-properties (point-at-bol) (point-at-eol)) result)
10522 (setq s (point-at-bol)
10523 e (point-at-eol))
10524 (with-current-buffer tobuf
10525 (insert-buffer-substring infobuf s e)
10526 (insert "\n"))))))))))
10528 (defun anything-c-info-goto (node-line)
10529 (Info-goto-node (car node-line))
10530 (anything-goto-line (cdr node-line)))
10532 (defun anything-c-info-display-to-real (line)
10533 (and (string-match
10534 ;; This regexp is stolen from Info-apropos-matches
10535 "\\* +\\([^\n]*.+[^\n]*\\):[ \t]+\\([^\n]*\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" line)
10536 (cons (format "(%s)%s" (anything-attr 'info-file) (match-string 2 line))
10537 (string-to-number (or (match-string 3 line) "1")))))
10539 (defun anything-c-make-info-source (source file)
10540 `(,@source
10541 (name . ,(concat "Info Index: " file))
10542 (info-file . ,file)
10543 (init . anything-c-info-init)
10544 (display-to-real . anything-c-info-display-to-real)
10545 (get-line . buffer-substring)
10546 (candidates-in-buffer)
10547 (action ("Goto node" . anything-c-info-goto))))
10549 (defun anything-compile-source--info-index (source)
10550 (anything-aif (anything-interpret-value (assoc-default 'info-index source))
10551 (anything-c-make-info-source source it)
10552 source))
10553 (add-to-list 'anything-compile-source-functions 'anything-compile-source--info-index)
10555 (anything-document-attribute 'info-index "info-index plugin"
10556 "Create a source of info index very easily.
10558 ex. (defvar anything-c-source-info-wget '((info-index . \"wget\"))")
10560 (anything-document-attribute 'index-nodes "info-index plugin (optional)"
10561 "Index nodes of info file.
10563 If it is omitted, `Info-index-nodes' is used to collect index nodes.
10564 Some info files are missing index specification.
10566 ex. See `anything-c-source-info-screen'.")
10568 ;; Plug-in: candidates-file
10569 (defun anything-compile-source--candidates-file (source)
10570 (if (assoc-default 'candidates-file source)
10571 `((init anything-p-candidats-file-init
10572 ,@(let ((orig-init (assoc-default 'init source)))
10573 (cond ((null orig-init) nil)
10574 ((functionp orig-init) (list orig-init))
10575 (t orig-init))))
10576 (candidates-in-buffer)
10577 ,@source)
10578 source))
10579 (add-to-list 'anything-compile-source-functions 'anything-compile-source--candidates-file)
10581 (defun anything-p-candidats-file-init ()
10582 (destructuring-bind (file &optional updating)
10583 (anything-mklist (anything-attr 'candidates-file))
10584 (setq file (anything-interpret-value file))
10585 (with-current-buffer (anything-candidate-buffer (find-file-noselect file))
10586 (when updating
10587 (buffer-disable-undo)
10588 (font-lock-mode -1)
10589 (auto-revert-mode 1)))))
10591 (anything-document-attribute 'candidates-file "candidates-file plugin"
10592 "Use a file as the candidates buffer.
10594 1st argument is a filename, string or function name or variable name.
10595 If optional 2nd argument is non-nil, the file opened with `auto-revert-mode'.")
10597 ;; Plug-in: headline
10598 (defun anything-compile-source--anything-headline (source)
10599 (if (assoc-default 'headline source)
10600 (append '((init . anything-headline-init)
10601 (get-line . buffer-substring)
10602 (type . line))
10603 source
10604 '((candidates-in-buffer)
10605 (persistent-help . "Show this line")))
10606 source))
10607 (add-to-list 'anything-compile-source-functions 'anything-compile-source--anything-headline)
10609 (defun anything-headline-init ()
10610 (when (and (anything-current-buffer-is-modified)
10611 (with-current-buffer anything-current-buffer
10612 (eval (or (anything-attr 'condition) t))))
10613 (anything-headline-make-candidate-buffer
10614 (anything-interpret-value (anything-attr 'headline))
10615 (anything-interpret-value (anything-attr 'subexp)))))
10617 (anything-document-attribute 'headline "Headline plug-in"
10618 "Regexp string for anything-headline to scan.")
10619 (anything-document-attribute 'condition "Headline plug-in"
10620 "A sexp representing the condition to use anything-headline.")
10621 (anything-document-attribute 'subexp "Headline plug-in"
10622 "Display (match-string-no-properties subexp).")
10625 (defun anything-headline-get-candidates (regexp subexp)
10626 (with-current-buffer anything-current-buffer
10627 (save-excursion
10628 (goto-char (point-min))
10629 (if (functionp regexp) (setq regexp (funcall regexp)))
10630 (let (hierarchy curhead)
10631 (flet ((matched ()
10632 (if (numberp subexp)
10633 (cons (match-string-no-properties subexp) (match-beginning subexp))
10634 (cons (buffer-substring (point-at-bol) (point-at-eol))
10635 (point-at-bol))))
10636 (hierarchies (headlines)
10637 (1+ (loop for (_ . hierarchy) in headlines
10638 maximize hierarchy)))
10639 (vector-0-n (v n)
10640 (loop for i from 0 to hierarchy
10641 collecting (aref curhead i)))
10642 (arrange (headlines)
10643 (unless (null headlines) ; FIX headlines empty bug!
10644 (loop with curhead = (make-vector (hierarchies headlines) "")
10645 for ((str . pt) . hierarchy) in headlines
10646 do (aset curhead hierarchy str)
10647 collecting
10648 (cons
10649 (format "H%d:%s" (1+ hierarchy)
10650 (mapconcat 'identity (vector-0-n curhead hierarchy) " / "))
10651 pt)))))
10652 (if (listp regexp)
10653 (arrange
10654 (sort
10655 (loop for re in regexp
10656 for hierarchy from 0
10657 do (goto-char (point-min))
10658 appending
10659 (loop
10660 while (re-search-forward re nil t)
10661 collect (cons (matched) hierarchy)))
10662 (lambda (a b) (> (cdar b) (cdar a)))))
10663 (loop while (re-search-forward regexp nil t)
10664 collect (matched))))))))
10667 (defun anything-headline-make-candidate-buffer (regexp subexp)
10668 (with-current-buffer (anything-candidate-buffer 'local)
10669 (loop for (content . pos) in (anything-headline-get-candidates regexp subexp)
10670 do (insert
10671 (format "%5d:%s\n"
10672 (with-current-buffer anything-current-buffer
10673 (line-number-at-pos pos))
10674 content)))))
10676 (defun anything-headline-goto-position (pos recenter)
10677 (goto-char pos)
10678 (unless recenter
10679 (set-window-start (get-buffer-window anything-current-buffer) (point))))
10681 (defun anything-revert-buffer (candidate)
10682 (with-current-buffer candidate
10683 (when (or (buffer-modified-p)
10684 (not (verify-visited-file-modtime
10685 (get-buffer candidate))))
10686 (revert-buffer t t))))
10688 (defun anything-revert-marked-buffers (ignore)
10689 (mapc 'anything-revert-buffer (anything-marked-candidates)))
10691 (defun anything-kill-marked-buffers (ignore)
10692 (mapc 'kill-buffer (anything-marked-candidates)))
10694 ;; Plug-in: persistent-help
10695 (defun anything-compile-source--persistent-help (source)
10696 (append source '((header-line . anything-persistent-help-string))))
10697 (add-to-list 'anything-compile-source-functions 'anything-compile-source--persistent-help)
10699 (defun anything-persistent-help-string ()
10700 (substitute-command-keys
10701 (concat "\\<anything-map>\\[anything-execute-persistent-action]: "
10702 (or (anything-interpret-value (anything-attr 'persistent-help))
10703 (anything-aif (or (assoc-default 'persistent-action
10704 (anything-get-current-source))
10705 (assoc-default 'action
10706 (anything-get-current-source)))
10707 (cond ((symbolp it) (symbol-name it))
10708 ((listp it) (or (ignore-errors (caar it)) ""))))
10710 " (keeping session)")))
10712 (anything-document-attribute 'persistent-help "persistent-help plug-in"
10713 "A string to explain persistent-action of this source.
10714 It also accepts a function or a variable name.")
10716 ;;; (anything '(((name . "persistent-help test")(candidates "a")(persistent-help . "TEST"))))
10718 ;; Plug-in: Type customize
10719 (defun anything-c-uniq-list (lst)
10720 "Like `remove-duplicates' in CL.
10721 But cut deeper duplicates and test by `equal'. "
10722 (reverse (remove-duplicates (reverse lst) :test 'equal)))
10723 (defvar anything-additional-type-attributes nil)
10724 (defun anything-c-arrange-type-attribute (type spec)
10725 "Override type attributes by `define-anything-type-attribute'.
10727 The SPEC is like source. The symbol `REST' is replaced with original attribute value.
10729 Example: Set `play-sound-file' as default action
10730 (anything-c-arrange-type-attribute 'file
10731 '((action (\"Play sound\" . play-sound-file)
10732 REST ;; Rest of actions (find-file, find-file-other-window, ...)
10735 (add-to-list 'anything-additional-type-attributes
10736 (cons type
10737 (loop with typeattr = (assoc-default type anything-type-attributes)
10738 for (attr . value) in spec
10739 if (listp value)
10740 collect (cons attr
10741 (anything-c-uniq-list
10742 (loop for v in value
10743 if (eq v 'REST)
10744 append (assoc-default attr typeattr)
10745 else
10746 collect v)))
10747 else
10748 collect (cons attr value)))))
10749 (put 'anything-c-arrange-type-attribute 'lisp-indent-function 1)
10751 (defun anything-compile-source--type-customize (source)
10752 (anything-aif (assoc-default (assoc-default 'type source) anything-additional-type-attributes)
10753 (append it source)
10754 source))
10755 (add-to-list 'anything-compile-source-functions 'anything-compile-source--type-customize t)
10757 ;; Plug-in: default-action
10758 (defun anything-compile-source--default-action (source)
10759 (anything-aif (assoc-default 'default-action source)
10760 (append `((action ,it ,@(remove it (assoc-default 'action source))))
10761 source)
10762 source))
10763 (add-to-list 'anything-compile-source-functions 'anything-compile-source--default-action t)
10764 (anything-document-attribute 'default-action "default-action plug-in"
10765 "Default action.")
10767 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10769 (defun anything-c-find-file-or-marked (candidate)
10770 "Open file CANDIDATE or open anything marked files in background."
10771 (let ((marked (anything-marked-candidates))
10772 (ffap-newfile-prompt anything-ff-newfile-prompt-p)
10773 (find-file-wildcards nil))
10774 (if (> (length marked) 1)
10775 ;; Open all marked files in background and display
10776 ;; the first one.
10777 (progn (mapc 'find-file-noselect (cdr marked))
10778 (find-file (car marked)))
10779 (if (and (not (file-exists-p candidate))
10780 (and ffap-url-regexp
10781 (not (string-match ffap-url-regexp candidate)))
10782 (string-match "/$" candidate))
10783 ;; A a non--existing filename ending with /
10784 ;; Create a directory and jump to it.
10785 (when (y-or-n-p (format "Create directory `%s'? " candidate))
10786 (let ((dirfname (directory-file-name candidate)))
10787 (if (file-exists-p dirfname)
10788 (error "Mkdir: Unable to create directory `%s': file exists."
10789 (anything-c-basename dirfname))
10790 (make-directory candidate 'parent)))
10791 (anything-find-files-1 candidate))
10792 ;; A non--existing filename NOT ending with / or
10793 ;; an existing filename, create or jump to it.
10794 (find-file-at-point (car marked))))))
10796 (defun anything-delete-marked-files (ignore)
10797 (let* ((files (anything-marked-candidates))
10798 (len (length files)))
10799 (if (not (y-or-n-p
10800 (format "Delete *%s File(s):\n%s"
10802 (mapconcat (lambda (f) (format "- %s\n" f)) files ""))))
10803 (message "(No deletions performed)")
10804 (dolist (i files)
10805 (set-text-properties 0 (length i) nil i)
10806 (anything-c-delete-file i))
10807 (message "%s File(s) deleted" len))))
10809 (defun anything-ediff-marked-buffers (candidate &optional merge)
10810 "Ediff 2 marked buffers or 1 marked buffer and current-buffer.
10811 With optional arg `merge' call `ediff-merge-buffers'."
10812 (let ((lg-lst (length (anything-marked-candidates)))
10813 buf1 buf2)
10814 (case lg-lst
10816 (error "Error:You have to mark at least 1 buffer"))
10818 (setq buf1 anything-current-buffer
10819 buf2 (first (anything-marked-candidates))))
10821 (setq buf1 (first (anything-marked-candidates))
10822 buf2 (second (anything-marked-candidates))))
10824 (error "Error:To much buffers marked!")))
10825 (if merge
10826 (ediff-merge-buffers buf1 buf2)
10827 (ediff-buffers buf1 buf2))))
10829 (defun anything-bookmark-get-bookmark-from-name (bmk)
10830 "Return bookmark name even if it is a bookmark with annotation.
10831 e.g prepended with *.
10832 Return nil if bmk is not a valid bookmark."
10833 (let ((bookmark (replace-regexp-in-string "\*" "" bmk)))
10834 (if (assoc bookmark bookmark-alist)
10835 bookmark
10836 (when (assoc bmk bookmark-alist)
10837 bmk))))
10839 (defun anything-delete-marked-bookmarks (ignore)
10840 "Delete this bookmark or all marked bookmarks."
10841 (dolist (i (anything-marked-candidates))
10842 (bookmark-delete (anything-bookmark-get-bookmark-from-name i)
10843 'batch)))
10845 (defun anything-require-or-error (feature function)
10846 (or (require feature nil t)
10847 (error "Need %s to use `%s'." feature function)))
10849 (defun anything-find-buffer-on-elscreen (candidate)
10850 "Open buffer in new screen, if marked buffers open all in elscreens."
10851 (anything-require-or-error 'elscreen 'anything-find-buffer-on-elscreen)
10852 (anything-aif (anything-marked-candidates)
10853 (dolist (i it)
10854 (let ((target-screen (elscreen-find-screen-by-buffer
10855 (get-buffer i) 'create)))
10856 (elscreen-goto target-screen)))
10857 (let ((target-screen (elscreen-find-screen-by-buffer
10858 (get-buffer candidate) 'create)))
10859 (elscreen-goto target-screen))))
10861 (defun anything-elscreen-find-file (file)
10862 (anything-require-or-error 'elscreen 'anything-elscreen-find-file)
10863 (elscreen-find-file file))
10865 ;; Toggle anything-match-plugin
10866 (defvar anything-mp-initial-highlight-delay nil)
10867 (defun anything-c-toggle-match-plugin ()
10868 "Toggle anything-match-plugin."
10869 (interactive)
10870 (let ((anything-match-plugin-enabled
10871 (member 'anything-compile-source--match-plugin
10872 anything-compile-source-functions)))
10873 (flet ((disable-match-plugin ()
10874 (setq anything-compile-source-functions
10875 (delq 'anything-compile-source--match-plugin
10876 anything-compile-source-functions))
10877 (setq anything-mp-initial-highlight-delay
10878 anything-mp-highlight-delay)
10879 (setq anything-mp-highlight-delay nil))
10880 (enable-match-plugin ()
10881 (require 'anything-match-plugin)
10882 (unless anything-mp-initial-highlight-delay
10883 (setq anything-mp-initial-highlight-delay
10884 anything-mp-highlight-delay))
10885 (setq anything-compile-source-functions
10886 (cons 'anything-compile-source--match-plugin
10887 anything-compile-source-functions))
10888 (unless anything-mp-highlight-delay
10889 (setq anything-mp-highlight-delay
10890 anything-mp-initial-highlight-delay))))
10891 (if anything-match-plugin-enabled
10892 (when (y-or-n-p "Really disable match-plugin? ")
10893 (disable-match-plugin)
10894 (message "Anything-match-plugin disabled"))
10895 (when (y-or-n-p "Really enable match-plugin? ")
10896 (enable-match-plugin)
10897 (message "Anything-match-plugin enabled"))))))
10899 ;; anything switch to buffer
10900 ;; Shut up byte compiler in emacs24.
10902 (defun anything-c-switch-to-buffer (buffer-or-name)
10903 "Same as `switch-to-buffer' whithout warnings at compile time."
10904 (with-no-warnings
10905 (switch-to-buffer buffer-or-name)))
10907 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Setup ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
10909 ;;;; Type Attributes
10910 (define-anything-type-attribute 'buffer
10911 `((action
10912 ("Switch to buffer" . anything-c-switch-to-buffer)
10913 ,(and (locate-library "popwin") '("Switch to buffer in popup window" . popwin:popup-buffer))
10914 ("Switch to buffer other window" . switch-to-buffer-other-window)
10915 ("Switch to buffer other frame" . switch-to-buffer-other-frame)
10916 ,(and (locate-library "elscreen") '("Display buffer in Elscreen" . anything-find-buffer-on-elscreen))
10917 ("Query replace regexp" . anything-c-buffer-query-replace-regexp)
10918 ("View buffer" . view-buffer)
10919 ("Display buffer" . display-buffer)
10920 ("Grep buffers (C-u grep all buffers)" . anything-c-grep-buffers)
10921 ("Revert buffer(s)" . anything-revert-marked-buffers)
10922 ("Insert buffer" . insert-buffer)
10923 ("Kill buffer(s)" . anything-kill-marked-buffers)
10924 ("Diff with file" . diff-buffer-with-file)
10925 ("Ediff Marked buffers" . anything-ediff-marked-buffers)
10926 ("Ediff Merge marked buffers" . (lambda (candidate)
10927 (anything-ediff-marked-buffers candidate t))))
10928 (persistent-help . "Show this buffer")
10929 (candidate-transformer anything-c-skip-current-buffer
10930 anything-c-skip-boring-buffers
10931 anything-c-transform-buffer-display-string))
10932 "Buffer or buffer name.")
10934 (define-anything-type-attribute 'file
10935 `((action
10936 ("Find file" . anything-find-many-files)
10937 ,(and (locate-library "popwin") '("Find file in popup window" . popwin:find-file))
10938 ("Find file as root" . anything-find-file-as-root)
10939 ("Find file other window" . find-file-other-window)
10940 ("Find file other frame" . find-file-other-frame)
10941 ("Open dired in file's directory" . anything-c-open-dired)
10942 ("Grep File(s) `C-u recurse'" . anything-find-files-grep)
10943 ("Pdfgrep File(s)" . anything-ff-pdfgrep)
10944 ("View file" . view-file)
10945 ("Insert file" . insert-file)
10946 ("Delete file(s)" . anything-delete-marked-files)
10947 ("Open file externally (C-u to choose)" . anything-c-open-file-externally)
10948 ("Open file with default tool" . anything-c-open-file-with-default-tool)
10949 ("Find file in hex dump" . hexl-find-file))
10950 (persistent-help . "Show this file")
10951 (action-transformer anything-c-transform-file-load-el
10952 anything-c-transform-file-browse-url)
10953 (candidate-transformer anything-c-w32-pathname-transformer
10954 anything-c-skip-current-file
10955 anything-c-skip-boring-files
10956 anything-c-shorten-home-path))
10957 "File name.")
10959 (let ((actions '(("Describe command" . describe-function)
10960 ("Add command to kill ring" . anything-c-kill-new)
10961 ("Go to command's definition" . find-function)
10962 ("Debug on entry" . debug-on-entry)
10963 ("Cancel debug on entry" . cancel-debug-on-entry)
10964 ("Trace function" . trace-function)
10965 ("Trace function (background)" . trace-function-background)
10966 ("Untrace function" . untrace-function))))
10967 (define-anything-type-attribute 'command
10968 `((action ("Call interactively" . anything-c-call-interactively)
10969 ,@actions)
10970 ;; Sort commands according to their usage count.
10971 ;(filtered-candidate-transformer . anything-c-adaptive-sort)
10972 (coerce . anything-c-symbolify)
10973 (persistent-action . describe-function))
10974 "Command. (string or symbol)")
10976 (define-anything-type-attribute 'function
10977 `((action . ,actions)
10978 (action-transformer anything-c-transform-function-call-interactively)
10979 (candidate-transformer anything-c-mark-interactive-functions)
10980 (coerce . anything-c-symbolify))
10981 "Function. (string or symbol)"))
10983 (define-anything-type-attribute 'variable
10984 '((action ("Describe variable" . describe-variable)
10985 ("Add variable to kill ring" . anything-c-kill-new)
10986 ("Go to variable's definition" . find-variable)
10987 ("Set variable" . anything-c-set-variable))
10988 (coerce . anything-c-symbolify))
10989 "Variable.")
10991 (define-anything-type-attribute 'sexp
10992 '((action ("Eval s-expression" . (lambda (c) (eval (read c))))
10993 ("Add s-expression to kill ring" . kill-new))
10994 (action-transformer anything-c-transform-sexp-eval-command-sexp))
10995 "String representing S-Expressions.")
10997 (define-anything-type-attribute 'bookmark
10998 `((coerce . anything-bookmark-get-bookmark-from-name)
10999 (action
11000 ("Jump to bookmark" . (lambda (bookmark)
11001 (let ((current-prefix-arg anything-current-prefix-arg))
11002 (bookmark-jump bookmark))
11003 (anything-update)))
11004 ("Jump to BM other window" . (lambda (bookmark)
11005 (bookmark-jump-other-window bookmark)
11006 (anything-update)))
11007 ("Bookmark edit annotation" . bookmark-edit-annotation)
11008 ("Bookmark show annotation" . bookmark-show-annotation)
11009 ("Delete bookmark(s)" . anything-delete-marked-bookmarks)
11010 ,@(and (locate-library "bookmark-extensions")
11011 `(("Edit Bookmark" . bmkext-edit-bookmark)))
11012 ("Rename bookmark" . bookmark-rename)
11013 ("Relocate bookmark" . bookmark-relocate)))
11014 "Bookmark name.")
11016 (define-anything-type-attribute 'line
11017 '((display-to-real . anything-c-display-to-real-line)
11018 (action ("Go to Line" . anything-c-action-line-goto)))
11019 "LINENO:CONTENT string, eg. \" 16:foo\".
11021 Optional `target-file' attribute is a name of target file.
11023 Optional `before-jump-hook' attribute is a function with no
11024 arguments which is called before jumping to position.
11026 Optional `after-jump-hook' attribute is a function with no
11027 arguments which is called after jumping to position.
11029 If `adjust' attribute is specified, searches the line whose
11030 content is CONTENT near the LINENO.
11032 If `recenter' attribute is specified, the line is displayed at
11033 the center of window, otherwise at the top of window.
11036 (define-anything-type-attribute 'file-line
11037 `((filtered-candidate-transformer anything-c-filtered-candidate-transformer-file-line)
11038 (multiline)
11039 (action ("Go to" . anything-c-action-file-line-goto)))
11040 "FILENAME:LINENO:CONTENT string, eg. \"~/.emacs:16:;; comment\".
11042 Optional `default-directory' attribute is a default-directory
11043 FILENAME is interpreted.
11045 Optional `before-jump-hook' attribute is a function with no
11046 arguments which is called before jumping to position.
11048 Optional `after-jump-hook' attribute is a function with no
11049 arguments which is called after jumping to position.
11051 If `adjust' attribute is specified, searches the line whose
11052 content is CONTENT near the LINENO.
11054 If `recenter' attribute is specified, the line is displayed at
11055 the center of window, otherwise at the top of window.
11058 (define-anything-type-attribute 'timer
11059 '((real-to-display . anything-c-timer-real-to-display)
11060 (action ("Cancel Timer" . cancel-timer)
11061 ("Describe Function" . (lambda (tm) (describe-function (timer--function tm))))
11062 ("Find Function" . (lambda (tm) (find-function (timer--function tm)))))
11063 (persistent-action . (lambda (tm) (describe-function (timer--function tm))))
11064 (persistent-help . "Describe Function"))
11065 "Timer.")
11067 ;;;; Default `anything-sources'
11068 ;; Setting `anything-sources' is DEPRECATED, but it seems that newbies
11069 ;; tend to invoke M-x anything directly. So I offer default setting.
11070 (setq anything-sources
11071 '(anything-c-source-buffers-list
11072 anything-c-source-recentf
11073 anything-c-source-files-in-current-dir+))
11075 ;; Unit tests are now in ../developer-tools/unit-test-anything-config.el.
11077 (provide 'anything-config)
11079 ;;; Local Variables:
11080 ;;; time-stamp-format: "%:y-%02m-%02d %02H:%02M:%02S (%Z) %u"
11081 ;;; End:
11083 ;; How to save (DO NOT REMOVE!!)
11084 ;; (progn (magit-push) (emacswiki-post "anything-config.el"))
11085 ;;; anything-config.el ends here
11087 ;;; LocalWords: Tassilo Patrovics Vagn Johansen Dahl Clementson infos
11088 ;;; LocalWords: Kamphausen informations McBrayer Volpiatto bbdb bb
11089 ;;; LocalWords: iswitchb imenu Recentf sym samewindow pos bol eol
11090 ;;; LocalWords: aif str lst func attrib recentf lessp prin mapatoms commandp
11091 ;;; LocalWords: cmd stb Picklist picklist mapcan subentry destructuring dirs
11092 ;;; LocalWords: darwin locat MacOS mdfind Firstname Lastname calc prepend jids
11093 ;;; LocalWords: dotimes Thierry online vname
11094 ;;; LocalWords: csharp javascript lua makefile cperl zcat lineno buf
11095 ;;; LocalWords: multiline href fn cand NewTitle cwd filepath thru ret
11096 ;;; LocalWords: bfn fOpen UNC cygdrive nt xdg macos FILE's elc rx svn hg
11097 ;;; LocalWords: CANDIDATE's darcs facep pathname args pathnames subseq priorty
11098 ;;; LocalWords: Vokes rfind berkeley JST ffap lacarte bos
11099 ;;; LocalWords: Lacarte Minibuf epp LaCarte bm attrset migemo attr conf mklist
11100 ;;; LocalWords: startpos noselect dont desc